【VBA】選択したフォルダ内のブックをまとめる【FileDialogとDir、Copyを使う】

Sub TEST1()
  
  Dim A
  'フォルダ選択用のダイアログ
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path '最初に開くフォルダ
    If .Show = False Then Exit Sub 'キャンセルで処理を終了
    A = .SelectedItems(1) '選択したフォルダのフォルダパスを取得
  End With
  
  Debug.Print A
  
End Sub

Sub TEST2()
  
  Dim A
  'フォルダ選択用のダイアログ
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path '最初に開くフォルダ
    If .Show = False Then Exit Sub 'キャンセルで処理を終了
    A = .SelectedItems(1) '選択したフォルダのフォルダパスを取得
  End With
  
  Dim B
  'フォルダ内の1つのブック名を取得
  B = Dir(A & "\*")
      
  'ブックを開く
  Workbooks.Open A & "\" & B
  
  Dim C
  '作業ファイルの最終行を取得
  Set C = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
  With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
    'データをコピー
    .Resize(.Rows.Count - 1).Offset(1, 0).Copy C.Offset(1, 1)
    'ブック名を入力
    C.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
  End With
  
  'ブックを閉じる
  ActiveWorkbook.Close False
  
End Sub

Sub TEST3()
  
  Dim A
  'フォルダ選択用のダイアログ
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = ThisWorkbook.Path '最初に開くフォルダ
    If .Show = False Then Exit Sub 'キャンセルで処理を終了
    A = .SelectedItems(1) '選択したフォルダのフォルダパスを取得
  End With
  
  Dim B
  'フォルダ内の1つのブック名を取得
  B = Dir(A & "\*")
  
  Do While B <> ""
    
    'ブックを開く
    Workbooks.Open A & "\" & B
    
    Dim C
    '作業ファイルの最終行を取得
    Set C = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
    With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
      'データをコピー
      .Resize(.Rows.Count - 1).Offset(1, 0).Copy C.Offset(1, 1)
      'ブック名を入力
      C.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
    End With
    
    'ブックを閉じる
    ActiveWorkbook.Close False
    
    B = Dir() '次のブック名を取得
    
  Loop
  
End Sub