ブック集約

Sub Sample()
Dim sFile As String
Dim sWB As Workbook, dWB As Workbook
Dim dSheetCount As Long
Dim i As Long
Const SOURCE_DIR As String = "C:\Users\user\Desktop\テスト設計書\"
Const DEST_FILE As String = "C:\Users\user\Desktop\ブックまとめる\AllReports.xlsx"

Application.ScreenUpdating = False

'指定したフォルダ内にあるブックのファイル名を取得
sFile = Dir(SOURCE_DIR & "*.xls?")

'フォルダ内にブックがなければ終了
If sFile = "" Then Exit Sub

'集約用ブックを作成
Set dWB = Workbooks.Add

'集約用ブック作成時のシート数を取得
dSheetCount = dWB.Worksheets.Count

Do
'コピー元のブックを開く
Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)

'コピー元の「報告書」シートを集約用ブックにコピー
sWB.Worksheets("本体").Copy After:=dWB.Worksheets(dSheetCount)

'シート名をセルA1の値に変更
ActiveSheet.Name = sFile

'コピー元ファイルを閉じる
sWB.Close

'次のブックのファイル名を取得
sFile = Dir()
Loop While sFile <> ""

'集約用ブック作成時にあったシートを削除
Application.DisplayAlerts = False
For i = dSheetCount To 1 Step -1
dWB.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

'集約用ブックを保存して閉じる
dWB.SaveAs Filename:=DEST_FILE
dWB.Close

Application.ScreenUpdating = False
End Sub