Sub CombineSheets() Dim ws As Worksheet Dim combinedSheet As Worksheet Dim lastRow As Long Dim targetRow As Long Dim headerRow As Range Dim dataRange As Range Dim cell As Range ‘ 結合先のシートを作成または指定します Set combinedSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) combinedSheet.Name = “CombinedData” ‘ 各シートのデータを結合先のシートにコピーして貼り付けます targetRow = 1 ‘ 結合先の最初の行 For Each ws In ThisWorkbook.Worksheets If ws.Name <> combinedSheet.Name Then lastRow = ws.Cells(ws.Rows.Count, “A”).End(xlUp).Row ‘ ヘッダー行を検索 For Each cell In ws.Rows(1).Cells If cell.Value = “JAN” Then Set headerRow = cell.EntireRow Exit For End If Next cell If Not headerRow Is Nothing Then ‘ ヘッダー行を除いたデータの範囲を設定 Set dataRange = ws.Range(“A” & headerRow.Row + 1 & “:D” & lastRow) ‘ ヘッダー行を含むデータをコピー dataRange.Copy combinedSheet.Cells(targetRow, 1) ‘ 次の結合先の行を更新 targetRow = targetRow + dataRange.Rows.Count End If End If Next ws End Sub これをアクティブなワークブックにしたい