ここでは 複数ブックにまたがって条件付きでピボットテーブルを複数種類（売上・数量など）同時に作成する VBAの例を紹介します。ポイントは「複数ブックをループして条件に合致するデータを統合し、その統合データを元に複数のピボットテーブルを新規作成する」ことです。
基本例：売上と数量の2種類のピボットテーブルを同時作成
Sub 複数ブックで複数ピボット作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim destWs As Worksheet
Dim lastRow As Long
Dim pasteRow As Long
Dim pc As PivotCache
Dim pt1 As PivotTable, pt2 As PivotTable
' 統合先シートを指定（このブックの「Master」シート）
Set destWs = ThisWorkbook.Sheets("Master")
destWs.Cells.Clear
pasteRow = 2
' 見出し
destWs.Range("A1").Value = "ブック名"
destWs.Range("B1").Value = "商品"
destWs.Range("C1").Value = "数量"
destWs.Range("D1").Value = "売上"
' 各ブックからデータを統合
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
' 条件：シート名が「Data」
If ws.Name = "Data" Then
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range("A2:D" & lastRow).Copy destWs.Range("B" & pasteRow)
' ブック名をA列に追加
destWs.Range("A" & pasteRow & ":A" & (pasteRow + lastRow - 2)).Value = wb.Name
pasteRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 1
End If
Next ws
End If
Next wb
' ピボットキャッシュ作成
Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=destWs.Range("A1:D" & pasteRow - 1))
' 既存の結果シートを削除して新規作成
On Error Resume Next
Worksheets("Pivot_数量").Delete
Worksheets("Pivot_売上").Delete
On Error GoTo 0
Worksheets.Add.Name = "Pivot_数量"
Worksheets.Add.Name = "Pivot_売上"
' ピボットテーブル1（数量）
Set pt1 = pc.CreatePivotTable( _
TableDestination:=Worksheets("Pivot_数量").Range("A3"), _
TableName:="数量ピボット")
With pt1
.PivotFields("商品").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("数量").Orientation = xlDataField
End With
' ピボットテーブル2（売上）
Set pt2 = pc.CreatePivotTable( _
TableDestination:=Worksheets("Pivot_売上").Range("A3"), _
TableName:="売上ピボット")
With pt2
.PivotFields("商品").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("売上").Orientation = xlDataField
End With
End Sub
👉 開いているすべてのブックから「Data」シートのデータを統合し、数量用ピボットと売上用ピボットを同時に作成します。
応用例：複数条件を組み合わせてピボットを作成
Sub 複数条件で複数ピボット作成()
Dim wb As Workbook
Dim ws As Worksheet
Dim destWs As Worksheet
Dim lastRow As Long
Dim pasteRow As Long
Dim pc As PivotCache
Dim pt1 As PivotTable, pt2 As PivotTable
Set destWs = ThisWorkbook.Sheets("Master")
destWs.Cells.Clear
pasteRow = 2
destWs.Range("A1").Value = "ブック名"
destWs.Range("B1").Value = "カテゴリ"
destWs.Range("C1").Value = "数量"
destWs.Range("D1").Value = "売上"
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name Then
For Each ws In wb.Worksheets
' 条件1: シート名が「Sales」で始まる
' 条件2: A1セルが「集計」と書かれている
If Left(ws.Name, 5) = "Sales" And ws.Range("A1").Value = "集計" Then
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
ws.Range("B2:D" & lastRow).Copy destWs.Range("B" & pasteRow)
destWs.Range("A" & pasteRow & ":A" & (pasteRow + lastRow - 2)).Value = wb.Name
pasteRow = destWs.Cells(destWs.Rows.Count, "B").End(xlUp).Row + 1
End If
Next ws
End If
Next wb
Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=destWs.Range("A1:D" & pasteRow - 1))
Worksheets.Add.Name = "Pivot_数量"
Worksheets.Add.Name = "Pivot_売上"
' 数量ピボット
Set pt1 = pc.CreatePivotTable(TableDestination:=Worksheets("Pivot_数量").Range("A3"))
With pt1
.PivotFields("カテゴリ").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("数量").Orientation = xlDataField
End With
' 売上ピボット
Set pt2 = pc.CreatePivotTable(TableDestination:=Worksheets("Pivot_売上").Range("A3"))
With pt2
.PivotFields("カテゴリ").Orientation = xlRowField
.PivotFields("ブック名").Orientation = xlColumnField
.PivotFields("売上").Orientation = xlDataField
End With
End Sub
ポイント
- 複数ピボットを同時作成 → 同じ
PivotCacheを使って複数のピボットを作成可能 - 条件判定 → シート名やセルの値を使って柔軟に対象を絞り込み
- 複数シートに出力 →
Worksheets.Add.Name = "Pivot_数量"のように複数シートを作成
練習課題
- 全ブックの「Sheet2」のデータを統合し、数量と売上の2種類のピボットを作成する
- 各シートのC1セルが「集計」と書かれていたら対象にして、地域別数量と売上をピボット化する
- 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないなら数量・売上の両方をピボット化する」コードを作る
こうした仕組みを作ると、複数ブックにまたがって条件付きでピボットテーブルを複数種類同時に作成する自動化ツールが完成します。
