Excel VBAで複数シートのデータを1シートにまとめる方法

Excelで複数のシートを1つにまとめる作業は手動では大変ですが、VBAを使えば効率よく行えます。本記事では、VBAを用いて1行目が同じデータを持つシートを縦に繋げ、各シートごとにまとめる方法を解説します。

1. VBAを使ったデータの集約方法
2. シートのデータを条件で絞り込む方法
3. データを異なるシートに分けて保存する方法
4. まとめ

1. VBAを使ったデータの集約方法

まず、ExcelにVBAマクロを組み込み、指定された複数のシートのデータを集めて1つのシートにまとめます。以下のVBAコードを使用して、指定の条件に従ってシートを集約できます。

Sub ConsolidateSheets()
Dim ws As Worksheet, newWs As Worksheet
Dim lastRow As Long, pasteRow As Long
Set newWs = ThisWorkbook.Sheets.Add '新しいシートを作成
newWs.Name = "ConsolidatedData"
pasteRow = 1

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> newWs.Name Then
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ws.Rows(1 & ":" & lastRow).Copy
        newWs.Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValues
        pasteRow = newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Row + 1
    End If
Next ws
End Sub

このコードは、指定されたシートのデータを1つのシートに縦に繋げていきます。シートごとにデータをまとめてコピーし、新しいシートに貼り付けます。

2. シートのデータを条件で絞り込む方法

もし、特定の条件（例えば1行目の数値や文字列が一致するシート）のみをまとめたい場合、その条件に基づいてシートをフィルタリングすることが可能です。以下のコードでは、1行目が特定の値を持つシートのみを集める方法を紹介します。

Sub FilterAndConsolidateSheets()
Dim ws As Worksheet, newWs As Worksheet
Dim lastRow As Long, pasteRow As Long
Set newWs = ThisWorkbook.Sheets.Add
newWs.Name = "FilteredData"
pasteRow = 1

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> newWs.Name Then
        If ws.Cells(1, 1).Value = "TargetValue" Then '指定された条件でフィルタ
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            ws.Rows(1 & ":" & lastRow).Copy
            newWs.Cells(pasteRow, 1).PasteSpecial Paste:=xlPasteValues
            pasteRow = newWs.Cells(newWs.Rows.Count, 1).End(xlUp).Row + 1
        End If
    End If
Next ws
End Sub

このコードを使えば、指定された値が1行目に存在するシートのみを選択してデータをまとめることができます。

3. データを異なるシートに分けて保存する方法

集約したデータをさらに、シートごとに異なるシートに分けて保存したい場合、以下のようにコードを変更することができます。この方法では、各シートごとにデータを分けて新しいExcelファイルに保存できます。

Sub SaveDataToDifferentSheets()
Dim ws As Worksheet, newWs As Worksheet
Dim lastRow As Long, pasteRow As Long
Dim newBook As Workbook
Set newBook = Workbooks.Add '新しいExcelファイルを作成

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "SheetToIgnore" Then '不要なシートはスキップ
        Set newWs = newBook.Sheets.Add
        newWs.Name = ws.Name
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        ws.Rows(1 & ":" & lastRow).Copy
        newWs.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    End If
Next ws
newBook.SaveAs "C:\path\to\save\newFile.xlsx" '保存先指定
newBook.Close
End Sub

この方法では、元のシートごとにデータを分けて新しいExcelファイルとして保存できます。