Excel VBA | 複数ブックにまたがって条件付きでピボットテーブルを複数種類同時にエクスポート

VBA
スポンサーリンク

ここでは 複数ブックにまたがって条件付きでピボットテーブルを複数種類同時にエクスポート(別ブックにまとめる) VBAの例を紹介します。ポイントは「複数ブックをループして条件に合致するピボットテーブルを見つけ、その結果をコピーして別の統合用ブックにまとめる」ことです。


基本例:各ブックの「Data」シートにある数量・売上ピボットをまとめてエクスポート

Sub 複数ブックでピボットエクスポート()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim destWb As Workbook
    Dim destWs As Worksheet
    Dim pasteRow As Long
    
    ' 統合先ブックを指定(事前に開いておく)
    Set destWb = Workbooks("PivotMaster.xlsx")
    Set destWs = destWb.Sheets("Export")
    destWs.Cells.Clear
    pasteRow = 1
    
    For Each wb In Application.Workbooks
        If wb.Name <> ThisWorkbook.Name And wb.Name <> destWb.Name Then
            For Each ws In wb.Worksheets
                ' 条件:シート名が「Data」
                If ws.Name = "Data" Then
                    For Each pt In ws.PivotTables
                        ' ピボット名に「数量」または「売上」が含まれる場合のみエクスポート
                        If InStr(pt.Name, "数量") > 0 Or InStr(pt.Name, "売上") > 0 Then
                            ' ピボットテーブルの結果範囲をコピー
                            pt.TableRange2.Copy destWs.Range("A" & pasteRow)
                            ' 貼り付け位置を更新
                            pasteRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 2
                        End If
                    Next pt
                End If
            Next ws
        End If
    Next wb
End Sub
VB

👉 開いているすべてのブックから「Data」シートにある 数量ピボット売上ピボット を探し、その結果を「PivotMaster.xlsx」の「Export」シートに順次コピーします。


応用例1:セルの値で判定してエクスポート

Sub セル値でピボットエクスポート()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim destWb As Workbook
    Dim destWs As Worksheet
    Dim pasteRow As Long
    
    Set destWb = Workbooks("PivotMaster.xlsx")
    Set destWs = destWb.Sheets("Export")
    pasteRow = 1
    
    For Each wb In Application.Workbooks
        For Each ws In wb.Worksheets
            ' A1セルが「エクスポート」と書かれていたら対象
            If ws.Range("A1").Value = "エクスポート" Then
                For Each pt In ws.PivotTables
                    pt.TableRange2.Copy destWs.Range("A" & pasteRow)
                    pasteRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 2
                Next pt
            End If
        Next ws
    Next wb
End Sub
VB

👉 各シートのA1セルに「エクスポート」と書かれている場合のみ、そのシートのピボットテーブルをまとめます。


応用例2:複数条件を組み合わせてエクスポート

Sub 複数条件でピボットエクスポート()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim destWb As Workbook
    Dim destWs As Worksheet
    Dim pasteRow As Long
    
    Set destWb = Workbooks("PivotMaster.xlsx")
    Set destWs = destWb.Sheets("Export")
    pasteRow = 1
    
    For Each wb In Application.Workbooks
        For Each ws In wb.Worksheets
            ' 条件1: シート名が「Sales」で始まる
            ' 条件2: B2セルが100以上
            If Left(ws.Name, 5) = "Sales" And ws.Range("B2").Value >= 100 Then
                For Each pt In ws.PivotTables
                    If InStr(pt.Name, "数量") > 0 Or InStr(pt.Name, "売上") > 0 Then
                        pt.TableRange2.Copy destWs.Range("A" & pasteRow)
                        pasteRow = destWs.Cells(destWs.Rows.Count, "A").End(xlUp).Row + 2
                    End If
                Next pt
            End If
        Next ws
    Next wb
End Sub
VB

👉 「Sales」で始まるシートかつB2セルが100以上なら、そのシートの数量・売上ピボットをまとめてエクスポートします。


ポイント

  • ピボット結果をコピーpt.TableRange2.Copy
  • 複数種類を同時に対象 → 名前に「数量」「売上」などを含めて判定
  • 統合先ブックを指定Set destWb = Workbooks("PivotMaster.xlsx")
  • 条件判定 → シート名やセルの値を使って柔軟に設定

練習課題

  1. 全ブックの「Sheet2」にあるピボットを「PivotMaster.xlsx」にまとめるコードを書いてみる
  2. 各シートのC1セルが「Export」と書かれていたら複数ピボットをまとめるコードを作る
  3. 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないなら数量・売上ピボットをまとめる」コードを作る

こうした仕組みを作ると、複数ブックにまたがって条件付きでピボットテーブルを複数種類同時にエクスポート(別ブックにまとめる)自動化ツールが完成します。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
タイトルとURLをコピーしました