複数シートのデータを1枚にまとめるVBAマクロ
「月ごとにシートが分かれていて、年間集計のときに全部コピペしている」——この作業をVBAで自動化します。シート数が増えても修正不要な汎用的なコードの作り方を解説します。
想定するシート構成
このコードは以下のような構成を想定しています。
Sheet1〜Sheet12:月別データ(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)
.Copy と Destination:= を組み合わせることで、コピーと貼り付けを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 で含まれているかどうかを判定できます。
実行前の確認事項
このコードを実行する前に確認してください。
- 「集計」という名前のシートが存在するか
- 各月シートの列構成が揃っているか(A〜D列がすべて同じ意味のデータか)
- 各月シートの1行目がヘッダー行になっているか(2行目からデータが始まるか)
列構成が違う場合(シートによってA列が違うデータになっている場合)は、コードの "A2:D" の部分を実際の列に合わせて変更してください。
まとめ
For Each ws In Worksheets で全シートを順番に処理する仕組みを覚えると、シート数が増えてもコードを変更せずに対応できます。月次・週次の集計作業がある場合、このパターンを自分のシート構成に合わせて使い回してみてください。