複数シートのデータを1枚にまとめるVBAマクロ

「月ごとにシートが分かれていて、年間集計のときに全部コピペしている」——この作業をVBAで自動化します。シート数が増えても修正不要な汎用的なコードの作り方を解説します。

想定するシート構成

このコードは以下のような構成を想定しています。

  • Sheet1Sheet12:月別データ(1行目はヘッダー、2行目以降にデータ)
  • 集計シート:全月のデータをまとめる先

各月シートのA列〜D列にデータが入っている場合を例にします。実際のシート構成に合わせて後半で調整します。

基本コード:全シートを順番に集計シートへ転記

まず「集計」という名前のシートを先に作成しておいてください。

Sub 全シートを集計()

    Dim ws As Worksheet       ' 転記元のシート(繰り返しで変わる)
    Dim wsDest As Worksheet   ' 転記先の集計シート
    Dim lastRow As Long       ' 転記元の最終行
    Dim destRow As Long       ' 転記先の書き込み位置

    ' 転記先シートを設定
    Set wsDest = Worksheets("集計")

    ' 集計シートの既存データをクリア(1行目のヘッダーは残す)
    If wsDest.Cells(2, 1).Value <> "" Then
        wsDest.Range("A2:D" & wsDest.Rows.Count).ClearContents
    End If

    destRow = 2  ' 集計シートの2行目から書き始める

    ' 全シートを順番に処理する
    For Each ws In Worksheets

        ' 「集計」シート自身はスキップする
        If ws.Name <> "集計" Then

            ' このシートの最終行を取得
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

            ' データがある場合のみ転記(2行目以降にデータがある場合)
            If lastRow >= 2 Then
                ' A列〜D列のデータをコピー
                ws.Range("A2:D" & lastRow).Copy Destination:=wsDest.Cells(destRow, 1)
                ' 転記先の行位置を更新
                destRow = destRow + (lastRow - 1)
            End If

        End If

    Next ws

    MsgBox "集計完了! " & destRow - 2 & " 件のデータをまとめました。"

End Sub

コードの解説

For Each〜Next でシートを順番に処理する

For Each ws In Worksheets
    ' 処理
Next ws

For〜Next はインデックス番号で繰り返しますが、For Each〜Next はコレクション(シートや行の集まり)の要素を順番に取り出して繰り返します。シート数が変わっても修正不要なため、汎用的なコードを書くときに便利です。

特定のシートをスキップする

If ws.Name <> "集計" Then
    ' 処理
End If

<> は「等しくない」を意味する比較演算子です。集計シート自身にデータを転記しようとするとエラーになるため、名前で除外します。

データのコピーと貼り付け

ws.Range("A2:D" & lastRow).Copy Destination:=wsDest.Cells(destRow, 1)

.CopyDestination:= を組み合わせることで、コピーと貼り付けを1行で書けます。この書き方は値だけでなく書式もコピーされます。

値だけを転記したい場合

書式はコピーせず、データの値だけを転記したい場合は以下の書き方を使います。

' 値のみ転記するバージョン
If lastRow >= 2 Then
    Dim copyRange As Range
    Dim copyRows As Long
    copyRows = lastRow - 1  ' コピーする行数

    Set copyRange = ws.Range("A2:D" & lastRow)
    wsDest.Cells(destRow, 1).Resize(copyRows, 4).Value = copyRange.Value

    destRow = destRow + copyRows
End If

Resize(行数, 列数) は指定したサイズの範囲を作る命令です。.Value = コピー元.Value で値のみを転記できます。

シート名ごとに列を追加したい場合

「どのシートから転記したか」をE列にシート名として記録したい場合は、転記後に追加します。

If lastRow >= 2 Then
    ws.Range("A2:D" & lastRow).Copy Destination:=wsDest.Cells(destRow, 1)

    ' E列にシート名を記録する
    Dim copyRows As Long
    copyRows = lastRow - 1
    wsDest.Cells(destRow, 5).Resize(copyRows, 1).Value = ws.Name

    destRow = destRow + copyRows
End If

月別シートなら ws.Name が「1月」「2月」などになり、集計後にフィルターで絞り込むときに便利です。

特定のシートだけ集計したい場合

シート名が「1月」〜「12月」のように規則的な場合は、シート名でフィルタリングできます。

' シート名に「月」が含まれているシートのみ処理する
For Each ws In Worksheets
    If InStr(ws.Name, "月") > 0 Then
        ' 処理
    End If
Next ws

InStr(文字列, 検索語) は文字列の中に検索語が含まれていれば1以上の数値を返します。含まれていない場合は0を返すため、> 0 で含まれているかどうかを判定できます。

実行前の確認事項

このコードを実行する前に確認してください。

  1. 「集計」という名前のシートが存在するか
  2. 各月シートの列構成が揃っているか(A〜D列がすべて同じ意味のデータか)
  3. 各月シートの1行目がヘッダー行になっているか(2行目からデータが始まるか)

列構成が違う場合(シートによってA列が違うデータになっている場合)は、コードの "A2:D" の部分を実際の列に合わせて変更してください。

まとめ

For Each ws In Worksheets で全シートを順番に処理する仕組みを覚えると、シート数が増えてもコードを変更せずに対応できます。月次・週次の集計作業がある場合、このパターンを自分のシート構成に合わせて使い回してみてください。