VBA - Copied Workbook, Pivot Data Source not Updating

MarissaReyes 

Yes I did! I think I googled every variation of this question before I finally got a solution to work.

The main thing that helped me was creating the updatepivot sub to handle this. It's been a minute since I looked at this, but basically the pivot tables & caches weren't renaming correctly, and were pointing to the old workbook. The updatepivot sub, loops through every pivot table in the workbook and creates a properly named cache. It searches for the "!", splits the names off, and deletes everything before that so you're just left with the correct name and not the "'workbook'!table" mess. 

After calling that, having the workbook calculate and refreshing all seemed necessary. Can't remember but I think the updatepivot sub didn't work on its own without this.

Let me know if this works!

This is my full code:

Sub updatepivot(wb As Workbook)

    Dim pt As PivotTable, ws As Worksheet, ar
    For Each ws In wb.Sheets
        For Each pt In ws.PivotTables
            ar = Split(pt.PivotCache.SourceData, "!")
            If UBound(ar) = 1 Then
               'Debug.Print pt.Name, pt.PivotCache.SourceData, ar(1)
               pt.ChangePivotCache wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ar(1))
               pt.SaveData = True
            End If
        Next
    Next

End Sub

Sub CreateTracings()

    Dim wsGraphs As Worksheet: Set wsGraphs = Sheets("Graphs")
    Dim new_wb As Workbook, ws As Worksheet
    Dim UserName As String, myFolder As String, rslname As String, TimeTaken As String, myDate As String
    Dim LastRow As Long, i As Long, n As Long
    Dim StartTime As Double
    
    ' Message boxes
    myDate = InputBox("Please Enter Tracings Date: ex. June 2021")
        If (StrPtr(myDate) = 0) Then
            Exit Sub
        End If
    'Debug.Print myDate
 
    ' Start timer
    StartTime = Timer

    ' scan each RSL
    Application.ScreenUpdating = False
    LastRow = wsGraphs.Range("BA" & wsGraphs.Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        rslname = wsGraphs.Range("BA" & i)
        
        ' Copy workbook
        ActiveWorkbook.Sheets.Copy
        Set new_wb = ActiveWorkbook
        
        ' Delete Sales Region Trending Tab
        Application.DisplayAlerts = False
        For Each ws In new_wb.Worksheets
            If ws.Name = "Sales Region Trending" Then
                ws.Delete
            End If
        Next
        Application.DisplayAlerts = False

         ' Filter and delete from sales data
        Dim SalesRange As Range
        Set SalesRange = new_wb.Sheets("Sales Data-No Hardware").Range("B2:S" & [SalesData].Cells(Rows.Count, 2).End(xlUp).Row)
        SalesRange.AutoFilter Field:=14, Criteria1:="<>" & rslname
    
        On Error Resume Next
        With SalesRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
        End With
        Err.Clear
        On Error GoTo 0
        
        'Filter and delete hardware data
        Dim rngHardware As Range
        Set rngHardware = new_wb.Sheets("Hardware Data").Range("A1:Q" & Sheets("Hardware Data").Cells(Rows.Count, 2).End(xlUp).Row)
        rngHardware.AutoFilter Field:=14, Criteria1:="<>" & rslname
        
        On Error Resume Next
        With rngHardware
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
        End With
        Err.Clear
        On Error GoTo 0
        
        ' change data source
        Call updatepivot(new_wb)

        'Refresh all pivot tables
        Calculate
        ActiveWorkbook.RefreshAll
        
        'Saving tracing copy
        UserName = Environ("Username")
        myFolder = "C:\Users\" & UserName & "\Desktop\Field Tracings\"
        
        'Creates Field Tracings folder if missing
        If Dir(myFolder, vbDirectory) = "" Then
            MkDir myFolder
        End If
            
        'Saves Active workbook
        rslsavename = rslname & " - " & myDate & " Tracings"
        new_wb.SaveAs Filename:=myFolder & rslsavename, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        
        'Close activeworkbook
        new_wb.Close False
        n = n + 1
    Next i
    
    Application.ScreenUpdating = True
    
    TimeTaken = Format((Timer - StartTime) / 86400, "hh:mm:ss")
    MsgBox n & " workbooks created in " & myFolder & vbNewLine & "Time Taken: " & TimeTaken & " (hours, minutes, seconds)", vbInformation
    
End Sub