Need Assistance With VBA Code To Change Pivot Source In Excel

I need to change Pivot Source for multiple sheets. I am receiving error “Run-Time Error 424: Object Required” when executing Invoke VBA for code listed below. Note: The range for the source data will always be “A3”, but with a different Source Sheet Name.

SheetName = Excel Sheet that contains Pivot Table
SourceSheetName = Sheet for Pivot Table Source

Sub Change_Pivot_Source(SheetName,SourceSheetName, IntLastRow, IntLastColumn)

SheetName.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
    PivotCaches.Create(SourceType:=xlDatabase _
        , SourceData:=SourceSheetName.Range(Cells(1, 3), Cells(IntLastRow, IntLastColumn)) _
        , Version:=8)

End Sub

Hi @randy.stokes

Try with code

Sub Change_Pivot_Source()

    Dim pt As PivotTable

    For Each pt In ActiveWorkbook.Worksheets("Sheet2").PivotTables
             pt.ChangePivotCache ActiveWorkbook.PivotCaches.Create _
                (SourceType:=xlDatabase, SourceData:="Data2")
    Next pt

End Sub

Check out the Video Link



I have 6 sheets in an excel file. Sheets 1 & 2 use Sheet 5 as data source for pivot table, Sheets 3 & 4 use Sheet 6 as data source for pivot table. The range for Sheets 5 and 6 will be dynamic. Need to be able to pass parms to Invoke VBA.

I was able to resolve is by using to following VBA code.

Sub Change_Pivot_Source(SheetName,SheetSource,SourceRange,ErrMessage)

'PURPOSE: Automatically readjust a Pivot Table’s data source range

Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String

'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets(SheetSource)
Set Pivot_sht = ThisWorkbook.Worksheets(SheetName)

'Enter in Pivot Table Name
PivotName = “PivotTable1”

'Dynamically Setup Range Address of Data
Set DataRange = Data_sht.Range(SourceRange)

NewRange = Data_sht.Name & “!” & _

'Make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
ErrMessage = “One of your data columns has a blank heading. Please fix and re-run!”
Exit Sub
End If

'Change Pivot Table Data Source Range Address
Pivot_sht.PivotTables(PivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _

'Ensure Pivot Table is Refreshed

End Sub

This topic was automatically closed 3 days after the last reply. New replies are no longer allowed.