Sub アクティブブックのシートをまとめる()
Dim ws As Worksheet
Dim summarySheet As Worksheet
Dim lastRowSummary As Long, lastRowSource As Long
Dim lastCol As Long
Dim sourceRange As Range, destinationRange As Range
' 新しいシートを作成
Set summarySheet = Sheets.Add(After:=Sheets(Sheets.Count))
summarySheet.Name = "まとめ"
' シートの数だけ繰り返し
For Each ws In Worksheets
' 対象シートのデータ範囲を取得
lastRowSource = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Set sourceRange = ws.Range(ws.Cells(1, 1), ws.Cells(lastRowSource, lastCol))
' まとめるシートの次の行にデータを追加
'lastRowSummary = summarySheet.Cells(summarySheet.Rows.Count, "A").End(xlUp).row + 1
lastRowSummary = summarySheet.Cells(summarySheet.Rows.Count, "A").End(xlUp).row
Set destinationRange = summarySheet.Range(summarySheet.Cells(lastRowSummary, 1), summarySheet.Cells(lastRowSummary + lastRowSource - 1, lastCol))
sourceRange.Copy destinationRange
Next ws
End Sub