Loop through Worksheets to create Pivot Table from existing tables

user_16945851 0
Viewed 183

I've searched and found Create Pivot tables within a for loop, but haven't been able to get it to work.

I've got a workbook with 11 sheets and a table in each sheet, so I'd like to create a loop that will go through every sheet and create a pivot table next to the existing table.

I'm getting an "Invalid Procedure or argument " error for the Pivot Table code.

This code is probably far too simple, but here's my attempt:

sub PivotLoop()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

    Set cache = Nothing
    Set PivT = Nothing

    With ws
                    
        On Error Resume Next             
        On Error GoTo 0
                   
        Set cache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                     SourceData:=Range("Table" & ws.Index), Version:=xlPivotTableVersion15)

        Set PivT = ws.PivotTables.Add(PivotCache:=cache, _
                    TableDestination:=Range("h2"), TableName:="PivotTable" & ws.Index)
                
    End With                  
Next ws

End Sub
vba excel
2 Answers

It's done essentially like this. In your specific case, it will obviously be slightly different, depending on your sheet names, your ranges, whether you want counts, sums, averages, etc.

Option Explicit

Sub test()

    Dim ws As Worksheet
    
    For Each ws In ThisWorkbook.Worksheets

        ' don't touch a sheet with a specific name...if needed...
        If ws.Name <> "Master" Then

                ' now we want to build a pivot table
                Range("A1").Select
                Sheets.Add
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                    "Sheet1!R1C1:R10C3", Version:=xlPivotTableVersion15).CreatePivotTable _
                    TableDestination:="Sheet5!R3C1", TableName:="PivotTable1", DefaultVersion _
                    :=xlPivotTableVersion15
                With ActiveSheet.PivotTables("PivotTable1").PivotFields("field1")
                    .Orientation = xlRowField
                    .Position = 1
                End With
                With ActiveSheet.PivotTables("PivotTable1").PivotFields("field2")
                    .Orientation = xlColumnField
                    .Position = 1
                End With
                ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
                    "PivotTable1").PivotFields("field3"), "Sum of field3", xlSum

        End If
    Next ws
    
End Sub

It helps a lot if you turn on the Macro recorder and see what kind of code it produces and you click through the steps.

user_52126140

Got it to work if anyone else wants to do it.

sub PivotTableLoop ()

Dim ws as Worksheet
Dim PivC As PivotCache
Dim PivT As PivotTable
Dim Table As ListObject
    
    For Each ws In WeeklyReport.Worksheets

    Set PivC = Nothing
    Set PivT = Nothing
    Set Table = Nothing
    
            On Error Resume Next
            '   Set PivotTable Cache
            Set PivC = WeeklyReport.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=ws.ListObjects(1), Version:=xlPivotTableVersion15)

            '   Create the PivotTable
            Set PivT = ws.PivotTables.Add(PivotCache:=PivC, _
            TableDestination:=ws.Range("i2"), TableName:="PivotTable" & ws.Index)
            On Error GoTo 0
                    
                For Each PivT In ws.PivotTables
                    
                        PivT.PivotFields("day").Orientation = xlRowField
                        PivT.PivotFields("Competitor").Orientation = xlColumnField
                        PivT.AddDataField PivT.PivotFields("Sales"), xlSum
                        PivT.PivotFields("Sales").NumberFormat = "$0.00"
            
                Next PivT
                    
                    
    Next ws

End Sub
user_169458510
Related