Recreate Source Data from PivotTable Cache

Unfortunately, there appears to be no way to directly manipulate PivotCache in Excel.

I did find a work around. The following code extracts the the pivot cache for every pivot table found in a workbook, puts it into a new pivot table and creates only one pivot field (to ensure that all rows from the pivot cache are incorporated in the total), and then fires ShowDetail, which creates a new sheet with all of the pivot table's data in.

I would still like to find a way to work directly with PivotCache but this gets the job done.

Public Sub ExtractPivotTableData()    Dim objActiveBook As Workbook    Dim objSheet As Worksheet    Dim objPivotTable As PivotTable    Dim objTempSheet As Worksheet    Dim objTempPivot As PivotTable    If TypeName(Application.Selection) <> "Range" Then        Beep        Exit Sub    ElseIf WorksheetFunction.CountA(Cells) = 0 Then        Beep        Exit Sub    Else        Set objActiveBook = ActiveWorkbook    End If    With Application        .ScreenUpdating = False        .DisplayAlerts = False    End With    For Each objSheet In objActiveBook.Sheets        For Each objPivotTable In objSheet.PivotTables            With objActiveBook.Sheets.Add(, objSheet)                With objPivotTable.PivotCache.CreatePivotTable(.Range("A1"))                    .AddDataField .PivotFields(1)                End With                .Range("B2").ShowDetail = True                objActiveBook.Sheets(.Index - 1).Name = "SOURCE DATA FOR SHEET " & objSheet.Index                objActiveBook.Sheets(.Index - 1).Tab.Color = 255                .Delete            End With        Next    Next    With Application        .ScreenUpdating = True        .DisplayAlerts = True    End WithEnd Sub

Go to the Immediate Window and type

?thisworkbook.PivotCaches(1).QueryType

If you get something other than 7 (xlADORecordset), then the Recordset property does not apply to this type of PivotCache and will return that error.

If you get an error on that line, then your PivotCache is not based on external data at all.

If your source data comes from ThisWorkbook (i.e. Excel data), then you can use

?thisworkbook.PivotCaches(1).SourceData

To create a range object and loop through it.

If your QueryType is 1 (xlODBCQuery), then SourceData will contain the connection string and commandtext for you to create and ADO recordset, like this:

Sub DumpODBCPivotCache()    Dim pc As PivotCache    Dim cn As ADODB.Connection    Dim rs As ADODB.Recordset    Set pc = ThisWorkbook.PivotCaches(1)    Set cn = New ADODB.Connection    cn.Open pc.SourceData(1)    Set rs = cn.Execute(pc.SourceData(2))    Sheet2.Range("a1").CopyFromRecordset rs    rs.Close    cn.Close    Set rs = Nothing    Set cn = NothingEnd Sub

You need the ADO reference, but you said you already have that set.

I found myself having the same problem, needing to scrape programmatically data coming different Excels with cached Pivot data.Although the topic is a bit old, still looks there is no direct way to access the data.

Below you can find my code, which is a more generalized refinement of the already-posted solution.

The major difference is the filter removal from fields, as sometimes pivot comes with filters on, and if you call .Showdetail it will miss filtered data.

I use it to scrape from different file format without having to open them, it is serving me quite well thus far.

Hope it is useful.

Credit to spreadsheetguru.com on the filter cleaning routine (although I don't remember how much is original and how much is mine to be honest)

Option Explicit        Sub ExtractPivotData(wbFullName As String, Optional wbSheetName As_ String, Optional wbPivotName As String, Optional sOutputName As String, _Optional sSheetOutputName As String)    ' This routine extracts full data from an Excel workbook and saves it to an .xls file.    Dim iPivotSheetCount As IntegerDim wbPIVOT As Workbook, wbNEW As Workbook, wsPIVOT As WorksheetDim wsh As Worksheet, piv As PivotTable, pf As PivotFieldDim sSaveTo As StringApplication.DisplayAlerts = FalsecalcOFFSet wbPIVOT = Workbooks.Open(wbFullName)    ' loop through sheets    For Each wsh In wbPIVOT.Worksheets        ' if it is the sheet we want, OR if no sheet specified (in which case loop through all)        If (wsh.name = wbSheetName) Or (wbSheetName = "") Then            For Each piv In wsh.PivotTables            ' remove all filters and fields            PivotFieldHandle piv, True, True            ' make sure there's at least one (numeric) data field            For Each pf In piv.PivotFields                If pf.DataType = xlNumber Then                    piv.AddDataField pf                    Exit For                End If            Next pf            ' make sure grand totals are in            piv.ColumnGrand = True            piv.RowGrand = True            ' get da data            piv.DataBodyRange.Cells(piv.DataBodyRange.Cells.count).ShowDetail = True            ' rename data sheet            If sSheetOutputName = "" Then sSheetOutputName = "datadump"            wbPIVOT.Sheets(wsh.Index - 1).name = sSheetOutputName            ' move it to new sheet            Set wbNEW = Workbooks.Add            wbPIVOT.Sheets(sSheetOutputName).Move Before:=wbNEW.Sheets(1)            ' clean new file            wbNEW.Sheets("Sheet1").Delete            wbNEW.Sheets("Sheet2").Delete            wbNEW.Sheets("Sheet3").Delete            ' save it            If sOutputName = "" Then sOutputName = wbFullName            sSaveTo = PathWithSlash(wbPIVOT.path) & FilenameNoExtension(sOutputName) & "_data_" & piv.name & ".xls"            wbNEW.SaveAs sSaveTo            wbNEW.Close            Set wbNEW = Nothing            Next piv        End If    Next wshwbPIVOT.Close FalseSet wbPIVOT = NothingcalcONApplication.DisplayAlerts = TrueEnd SubSub PivotFieldHandle(pTable As PivotTable, Optional filterClear As Boolean, Optional fieldRemove As Boolean, Optional field As String)'PURPOSE: How to clear the Report Filter field'SOURCE: www.TheSpreadsheetGuru.comDim pf As PivotFieldSelect Case field    Case ""    ' no field specified - clear all!        For Each pf In pTable.PivotFields            Debug.Print pf.name            If fieldRemove Then pf.Orientation = xlHidden            If filterClear Then pf.ClearAllFilters        Next pf    Case Else    'Option 1: Clear Out Any Previous Filtering    Set pf = pTable.PivotFields(field)    pf.ClearAllFilters    '   Option 2: Show All (remove filtering)    '   pf.CurrentPage = "(All)"End SelectEnd Sub