マクロで別ブックのデータを集約したい

よろしくお願いします。
マクロ初心者で、いろいろ調べながら作業をしたのですが、うまくいきませんでした。

デスクトップ上に１つのフォルダがあり、その中に、コピー先ブックと20くらいのコピー元ブックがあります。コピー元ブックをコピー先ブックに集約したいです。

コピー元ブックのシート２のＢ列～Ｄ列の２行目から値が入力されている行までをコピーして、コピー先ブックのシート１のＢ列～Ｄ列の２行目以降に貼り付ける。
この作業を20くらいある全てのブックに対して実行して、コピー先ブックの下の行、下の行へと貼り付ける。
ただし、コピー元ブックのＡ２セルが空欄の場合、Ｂ～Ｄも空欄なので、作業する必要はありません。

初めての質問なのですが、これでわかりますか。よろしくお願いします。

質問者からの補足コメント

• 1.マクロは、コピー先ブックに格納します。
  2.xlsxです。
  3.Sheet2です。
  4.Sheet1です。
  よろしくお願いします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2021/08/28 19:46

No.3 ベストアンサー 回答者： tatsumaru77 回答日時： 2021/08/28 21:06

以下のマクロを標準モジュールに登録してください。

Option Explicit

Dim row1 As Long
Dim sh1 As Worksheet
Public Sub データ集約()
Dim siten_arr As Variant
Dim siten As Variant
Dim bookname As String
Set sh1 = Worksheets("Sheet1")
row1 = 2
bookname = Dir(ThisWorkbook.Path & "\" & "*.xlsx")
Do While bookname <> ""
Call get_book(bookname)
bookname = Dir()
Loop
MsgBox ("完了")
End Sub
'１つのファイルを処理する
Private Sub get_book(ByVal bookname As String)
Dim wb As Workbook
Dim maxrow As Long
Dim row2 As Long
Dim names As Variant
Dim sh2 As Worksheet
Dim base As String
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & bookname)
Set sh2 = wb.Worksheets("Sheet2")
'A2が空白ならコピーしない
If sh2.Range("A2").Value = "" Then
wb.Close
Exit Sub
End If
maxrow = sh2.Cells(Rows.Count, "B").End(xlUp).Row
For row2 = 2 To maxrow
sh1.Range("B" & row1 & ":D" & row1).Value = sh2.Range("B" & row2 & ":D" & row2).Value
row1 = row1 + 1
Next
wb.Close
End Sub

この回答へのお礼

助かりました。
正常に動きました。
難しい内容ですが、これをもとに勉強させていただきます。
迅速なご回答、どうもありがとうございました。

お礼日時：2021/08/28 21:41

No.2 回答者： tatsumaru77 回答日時： 2021/08/28 18:15

補足要求です。

１．マクロはコピー先ブックに格納する前提で良いですか。
２．コピー元ブックの拡張子は.xlsxでしょうか。それとも.xlsでしょうか。
３．コピー元ブックのシート名は"シート2"で間違いないですか。(Sheet2ではない)
４．コピー先ブックのシート名は"シート1"で間違いないですか。(Sheet1ではない)

No.1 回答者： mygoonickname 回答日時： 2021/08/28 17:50

こんばんは。

直接の回答ではなくすみませんが、質問者さんの作ったマクロを載せて、
　どこが、どの様にうまくいかないかを書いて貰えると、回答が付くかと
　思います。

私個人のポリシーになりますが、私が可能な限りアドバイスはしますが、
　１からのマクロの作成はしていませんので、悪しからず。。。