【Excel VBA】複数のブックの指定シート指定位置の値を順次まとめていくマクロ

複数のブックの内容を取りまとめるマクロを作りたいです。

取りまとめ用ブックにてマクロを実行すると、フォルダの場所を聞いてきて、
指定フォルダ内にあるエクセルを順次処理するというイメージです。

フォルダ内にあるエクセルは、ファイル名には規則性がなくバラバラですが、
シート名や入力されたセル位置は全て統一されています。

シートが複数あるので、
シート1のセルC3、C5
シート2のセルA4、E10
シート3のセルB22、F32
シート4のセルG9
という感じに指定された場所の値を拾ってきたいのです。

取りまとめ用ブックの、
D4、E4、F4、G4、H4、I4、J4に、
シート1のC3、C5、シート2のA4、E10、シート3のB22、F32、シート4のG9と1行に値で貼り付けられ、
次のブックは、
D5、E5・・・と1行下にずれながらフォルダ内のブックを全て処理するイメージです。
実現可能でしょうか？

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/04/20 21:33

こんばんは！

なかなか回答が付かないようなので、一例です。
コード記載ブックのSheet1に書き出すとします。
保存フォルダ内の対象ファイルの拡張子は「xlsx」としています。

Sub Sample1()
　Dim myPath As String, fN As String
　Dim wB As Workbook
　Dim cnt As Long

　　myPath = "保存場所のパス" & "\"
　　fN = Dir(myPath & "*.xlsx")
　　　cnt = 3
　　　Do Until fN = ""
　　　　If fN <> ThisWorkbook.Name Then
　　　　　Workbooks.Open myPath & fN
　　　　　　Set wB = ActiveWorkbook
　　　　　　cnt = cnt + 1
　　　　　　　With ThisWorkbook.Worksheets("Sheet1")
　　　　　　　　.Cells(cnt, "D") = wB.Worksheets(1).Range("C3")
　　　　　　　　.Cells(cnt, "E") = wB.Worksheets(1).Range("C5")
　　　　　　　　.Cells(cnt, "F") = wB.Worksheets(2).Range("A4")
　　　　　　　　.Cells(cnt, "G") = wB.Worksheets(2).Range("E10")
　　　　　　　　.Cells(cnt, "H") = wB.Worksheets(3).Range("B22")
　　　　　　　　.Cells(cnt, "I") = wB.Worksheets(3).Range("F32")
　　　　　　　　.Cells(cnt, "J") = wB.Worksheets(4).Range("G9")
　　　　　　　End With
　　　　　　wB.Close
　　　　　　fN = Dir()
　　　　End If
　　　Loop
　　　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？

※　コード内の「保存場所のパス」の部分は実際のパスにしてください。
もしコード記載のブックと同じフォルダ内に保存してあれば
＞myPath = ThisWorkbook.Path & "\"

で構いません。m(_ _)m

この回答へのお礼

ありがとうございます！
思った通りの動作をしてくれました。後は都度、フォルダを選択できるようにしたりすれば良いですね。
シート番号を調べておいてwB.Worksheets(1) と指定すればシート名を変えられたとしても特定できるって事ですね。

お礼日時：2019/04/23 10:16