メニュー 閉じる

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

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です