Transfer Pivot Cache from a Pivot on one file to a Pivot on another?

Question

I need to safely transfer the cache of a Pivot Table on an Excel File, into a pivot on a different file. How can I do this?

---

This is the code I'm using now (Notice this method works even if the Source pivot Data Source has been eliminated):

Public Sub TransferPivotCache(Source As PivotTable, Target As PivotTable)
    Dim TempSheet As Worksheet
    Set TempSheet = ThisWorkbook.Sheets.Add
    Source.TableRange2.Copy Destination:=TempSheet.Range("A1")
    Target.CacheIndex = TempSheet.PivotTables(1).CacheIndex
    TempSheet.Delete
End Sub

However when the pivot I'm importing is too big I get the error "Not enough memory" when modifying the cache index property. And afterwards, even the file closes and if I try to reopen it, it's corrupted. Is there a better way to transfer a Pivot Cache between pivot tables?

Answer 1

If your goal it to update another pivot table targeting the same data, then another way would be to create a new PivotCache pointing to the same source. This way, the targeted workbook will build the same PivotCache without the need to copy the DataTable, which is probably the cause of your memory issue.

Public Sub TransferPivotCache(source As PivotTable, target As PivotTable)
    Dim pivCache As PivotCache, sh As Worksheet, rgData As Range, refData

    ' convert the `SourceData` from `xlR1C1` to `xlA1` '
    source.Parent.Activate
    refData = Application.ConvertFormula(source.SourceData, xlR1C1, xlA1, xlAbsolute)
    If IsError(refData) Then refData = source.SourceData

    If Not IsError(source.Parent.Evaluate(refData)) Then
        ' create a new pivot cache from the data source if it exists '

        Set rgData = source.Parent.Evaluate(refData)
        If Not rgData.ListObject Is Nothing Then Set rgData = rgData.ListObject.Range

        Set pivCache = target.Parent.Parent.PivotCaches.Create( _
          XlPivotTableSourceType.xlDatabase, _
          rgData.Address(external:=True))

        pivCache.EnableRefresh = False
        target.ChangePivotCache pivCache
    Else
        ' copy the pivot cache since the data source no longer exists '

        Set sh = source.Parent.Parent.Sheets.Add
        source.PivotCache.CreatePivotTable sh.Cells(1, 1)
        sh.Move after:=target.Parent  ' moves the temp sheet to targeted workbook '

        ' replace the pivot cache '
        target.PivotCache.EnableRefresh = True
        target.CacheIndex = target.Parent.Next.PivotTables(1).CacheIndex
        target.PivotCache.EnableRefresh = False

        'remove the temp sheet '
        target.Parent.Next.Delete
    End If

End Sub