Sub CollectCDFormTables()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim tbl As ListObject
Dim summaryWs As Worksheet
Dim lastRow As Long
Dim srcRange As Range' フォルダパスの指定(最後に \ をつける) folderPath = "C:\YourFolderPath\" ' ←適宜変更してください ' まとめ先シートの準備 Set summaryWs = ThisWorkbook.Sheets("Summary") summaryWs.Cells.Clear lastRow = 1 ' フォルダ内のExcelファイルを順に処理 fileName = Dir(folderPath & "*.xls*") Do While fileName <> "" ' 対象ファイルを開く Set wb = Workbooks.Open(folderPath & fileName) ' 各シートを確認 For Each ws In wb.Worksheets On Error Resume Next Set tbl = ws.ListObjects("cdform") On Error GoTo 0 If Not tbl Is Nothing Then ' ヘッダーをコピー(最初のみ) If lastRow = 1 Then tbl.HeaderRowRange.Copy Destination:=summaryWs.Cells(lastRow, 1) lastRow = lastRow + 1 End If ' データ部分をコピー Set srcRange = tbl.DataBodyRange srcRange.Copy Destination:=summaryWs.Cells(lastRow, 1) lastRow = lastRow + srcRange.Rows.Count End If Set tbl = Nothing Next ws wb.Close SaveChanges:=False fileName = Dir() Loop MsgBox "取りまとめが完了しました。", vbInformation
End Sub