memo マージ

Sub 複数ブックマージ()
Dim A, B, C, D
  Set B = ThisWorkbook.Worksheets("Sheet1")
  'フォルダ内のブック名を取得
  C = Dir(ThisWorkbook.path & "\TEST\*")
  
  Do While C <> ""
        'ブックを開く
        Workbooks.Open ThisWorkbook.path & "\TEST\" & C
        'データ部分を取得
            With ActiveWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
              A = .Rows("2:" & .Rows.Count)  '開いたブックのシート１の２行目から最終行までを変数Ａ
            End With
        'データを入力
        D = ActiveWorkbook.Worksheets("Sheet1").Cells(1, 1).End(xlToRight).Column '開いたブックのシート１の最終列
        B.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(UBound(A, 1), D) = A  'マージするブックのＢ列の最終行＋１行から変数Ａの値反映
        'ブック名を入力
        B.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(UBound(A, 1)) = ActiveWorkbook.name 'A列にブック名
        ActiveWorkbook.Close False 'ブックを閉じる
        C = Dir() '次のブック名を取得
  Loop
  MsgBox "終了"
End Sub