hiko-blog

VBA業務改善

MENU

Excelのピボットテーブルで作成したような集計表から、リスト形式へ

Sub CreateOriginalTableFromPivotTable()
    Dim pt As PivotTable
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim rngSource As Range
    Dim rngDestination As Range
    Dim srcRow As Long
    Dim destRow As Long
    
    ' ピボットテーブルがあるシートの参照
    Set wsSource = ThisWorkbook.Sheets("PivotTableSheet")
    
    ' ピボットテーブルの参照
    Set pt = wsSource.PivotTables("PivotTableName")
    
    ' 元表を作成するシートの参照
    Set wsDestination = ThisWorkbook.Sheets.Add
    
    ' 元表のヘッダーを追加
    pt.ColumnRange.Copy
    wsDestination.Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
    
    ' 元表のデータを追加
    Set rngSource = pt.RowRange
    Set rngDestination = wsDestination.Cells(2, 1)
    srcRow = rngSource.Rows.Count
    destRow = rngDestination.Row
    
    rngSource.Copy
    rngDestination.PasteSpecial Paste:=xlPasteValues
    
    ' 列幅を調整
    wsDestination.Columns.AutoFit
    
    ' メッセージボックスを表示
    MsgBox "元表が作成されました。"
End Sub