[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『表記載の同フォルダ内のブックを開き、該当項目の値をコピーペーストする』（石川）
こんにちは。 当方VBA初心者です。 現在手作業で実施していることを、自動化したいと思っています。 部分的でもよいので、ご教示願えますでしょうか。
以下にやりたいことを記します。 説明不足の部分があればそちらも教えていただけると幸いです。
■■■Bフォルダ内 <C:\Users\username\Desktop\B>■■■
「各タイトル_WEB別売上表.xlsx」
「aaa_タイトルA.xlsx」 「bbb_タイトルA.xlsx」 「aaa_タイトルB.xlsx」 「ccc_タイトルB.xlsx」 「aaa_タイトルC.xlsx」 「bbb_タイトルC.xlsx」
「マクロ用.xlsm」
※すべて[Sheet1]。 ※「WEB名_タイトル名.xlsx」のフォーマットは同一 ※「WEB名_タイトル名.xlsx」は増える可能性あり
■■■■■■■■■■■■■■■■■■■■■■
「各タイトル_WEB別売上表.xlsx」 ----A---- ----B---- ----C---- ----D---- 1 タイトル名 WEB名 売上金 ブック名 2 タイトルB bbb 321,000 bbb_タイトルB 3 タイトルA aaa 50,000 aaa_タイトルA 4 タイトルC aaa 280,050 aaa_タイトルC 5 タイトルA bbb 150 bbb_タイトルA 6 タイトルB aaa 123,456 aaa_タイトルB 7 タイトルC bbb 45,000 bbb_タイトルC 8 9
「aaa_タイトルA.xlsx」 ----A---- ----B---- ----C---- ----D---- 1 WEB名 売上 売上金 配分 2 aaa 関数 50,000 関数 3
「bbb_タイトルA.xlsx」 ----A---- ----B---- ----C---- ----D---- 1 WEB名 売上 売上金 配分 2 bbb 関数 150 関数 3
「aaa_タイトルB.xlsx」 ----A---- ----B---- ----C---- ----D---- 1 WEB名 売上 売上金 配分 2 aaa 関数 123,456 関数 3
====================================
1「各タイトル_WEB別売上表.xlsx」を開く 2 D列 の「ブック名」を確認して、 3 同フォルダ内の「ブック名.xlsx」を開く 4「各タイトル_WEB別売上表.xlsx」の C列 の売上金をコピー 5 該当「ブック名.xlsx」の [C2] に売上金の値をペースト 6「各タイトル_WEB別売上表.xlsx」の最終行まで繰り返し 7 最終行まで終わったら 8「完了」のMsgboxをだす
以上、よろしくお願いいたします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
開くブック名は判っているのだし、それを WorkBooks.Open し、C2セルの値をイコールで代入するだけであり、難しいところは無さそうに見えます。
（???） 2017/08/16(水) 16:19
???様 ご返信ありがとうございます。 ヒントも教えていただきありがとうございます。
ゼロからマクロを書いた経験もなく、「マクロの記録」でやろうと思ったのですが、 記録したにも関わらずうまく動作せず、もっといい方法がないかと思いまして...。
そもそも、1〜8までの想定している手順も、もしかしたら別の手順のほうがスマートかもしれない、、 と何日か考えていますが、
なかなか考えがまとまらないままここへ質問してしまいました。すみません。
ちなみにマクロの記録でできたコードは以下です。
Sub test6()
' ' test6 Macro '
'
Range("D2").Select
Selection.Copy
Workbooks.Open Filename:="C:\Users\username\Desktop\B\bbb_タイトルB.xlsx"
Windows("各タイトル_WEB別売上表.xlsm").Activate
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Range("C2").Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False
End Sub
（石川） 2017/08/16(水) 16:51
集計用のシートに、ActiveXのボタンを貼り、シートモジュールとして以下のコードをコピペ、一旦ブック保存してから、マクロ有効で開き直し、ボタンを押してみてください。 今後は、ボタンを押すだけで、最新の値を持ってくるようになります。
Private Sub CommandButton1_Click()
Dim i As Long
'Application.ScreenUpdating = False
For i = 2 To Me.Cells(Me.Rows.Count, "D").End(xlUp).Row
With Workbooks.Open(ThisWorkbook.Path & "\" & Me.Cells(i, "D").Value & ".xlsx", False, True)
Me.Cells(i, "C").Value = .Sheets("Sheet1").Range("C2").Value
.Close False
End With
Next i
'Application.ScreenUpdating = True
MsgBox "完了", vbInformation
End Sub
（???） 2017/08/16(水) 17:24
???様 早速の回答ありがとうございます。 ただいま外出中ですので、のちほど試してみて、 ご返信させていただきます。
（石川） 2017/08/16(水) 17:28
???様 教えていただいた方法を試してみました。 エラーなく動作し、「完了」のポップアップまで出ましたが、 完了後フォルダ内の.xlsxファイルを見たところ、 下記のような状態になってしまいました。
・「各タイトル_WEB別売上表.xlsx」の C列[売上金]がすべて消えている ・各「WEB名_タイトル名.xlsx」のファイルの C2セルへ値が入っていない
考えられるのが、 各「WEB名_タイトル名.xlsx」のファイルの C2セルが元々 null のため、 それが「各タイトル_WEB別売上表.xlsx」のC列[売上金]へ反映されてしまったのか？ と思ったのが、合っておりますでしょうか...。
またPCから離れてしまいますので、取り急ぎご報告です。
（石川） 2017/08/16(水) 18:12
追記
Me.Cells(i, "C").Value = .Sheets("Sheet1").Range("C2").Value
この部分の左辺と右辺を変えればよいのでしょうか。 （石川） 2017/08/16(水) 18:25
各ブックに貼りつけていくならば、代入の左辺と右辺を逆にする事と、Workbooks.Openに指定している第2、第3引数を削除して、ファイル名だけにしてください。（読み取り専用を指定していました） 更に、代入しただけでCloseすると、結果が保存されないので、Close前にSaveする1行を追加してください。
（???） 2017/08/17(木) 09:15
一覧表(「各タイトル_WEB別売上表.xlsx」)のC列の値を、 各ブック(「WEB名_タイトル名.xlsx」)の[C2]セルへ貼り付ける。
という手順にしたいです。説明不足で申し訳ありません。
＞一覧表の値をコピーして、そのまま一覧表に貼りつけていた（つまり、見かけ上何もしない） たしかにマクロの記録で作成したコードだと何も起こらなかったです、、！
教えていただいた通り修正し、動かしてみてまたご連絡いたします。
（石川） 2017/08/17(木) 10:02
???さま お世話になっております。 ご指摘箇所を修正し、動かしてみたところ、 希望どおりの動作を確認することができました。 ありがとうございます！
今後、一覧表(「各タイトル_WEB別売上表.xlsx」)から 各ブックへ反映させる項目が増える可能性もあるので、 ご教示頂いたコードを基に更新していこうと思います。
正常に起動したコードを下記に記載いたします。
Private Sub CommandButton1_Click()
Dim i As Long
'Application.ScreenUpdating = False
For i = 2 To Me.Cells(Me.Rows.Count, "D").End(xlUp).Row
With Workbooks.Open(ThisWorkbook.Path & "\" & Me.Cells(i, "D").Value & ".xlsx")
.Sheets("Sheet1").Range("C2").Value = Me.Cells(i, "C").Value
.Save
.Close False
End With
Next i
'Application.ScreenUpdating = True
MsgBox "出来ました。" & vbLf & "よかった", vbOKOnly, "売上反映"
End Sub
以上、よろしくお願いいたします。 （石川） 2017/08/17(木) 10:30
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.