hiko-blog

VBA業務改善

MENU

アクティブブックのシートをまとめる

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