Hello all,

I have a project that contains three pivot tables that all reference one query table with some calculations next to it. Since the actual project relies on another query table (with an enormous amount of data), in order to save room on our server I have coded the pivot table worksheets to copy (by worksheet object) into a new workbook.

I've done this succesfully for similar projects in the past, but the problem I seem to now be facing is that when the new workbook is saved (using Excel 2007 .xlsx), that the pivot table essentially becomes a flat file. Any attempt to drill down to the pivot table details by double-clicking on a value just pulls up an empty table. Likewise, any attempt to modify the pivot table in any way essentially clears out the pivot table's contents.

My pivot tables are precreated from the template file, and everything is done via macro, but I'm wondering if anyone else has run into this issue with pivot-table oriented VB projects.

For your reference, below is the code that does the actual copying of pivot tables, though I don't see anything within the code itself that could be the cuase of this problem.

Thanks in advance.

Code:
option Explicit

Public Sub BABvsTDFCSTMain()
    If MsgBox("Please be advised that running this code will lock you out of Excel for approximatly 15 minutes while this program performs its complicated calculations.  Do you wish to continue?", vbYesNo, "Advisory") = vbYes Then
        
        RefreshAllQueries 'Refreshes two QueryTables





        RefreshSourcePivots 'Refreshes source pivots that get referenced via GetPivotData formulas later within the raw data
                
        
        '(irrelevant formula code removed)

        RefreshAllPivots 'Refreshes all pivots
        
        CopyPivots 'Copies the specific pivots I need to copy
        
        MsgBox "Finished updating data and pivots.  Please proceed to format pivots", vbInformation, "Everything has been refreshed."
        
        If MsgBox("Pivot tables have been copied to a new workbook.  Okay to close the template?", vbYesNo, "Close Template?") = vbYes Then
            ThisWorkbook.Close False 'this is a template, so we shouldn't even give the End User the opportunity to save anything (just in case I forget to make the template read-only)
        End If
    End If
End Sub

Private Sub RefreshAllQueries()
    Dim qryTable As QueryTable
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        For Each qryTable In ws.QueryTables
            qryTable.Refresh False
        Next qryTable
    Next ws
End Sub

Private Sub RefreshSourcePivots()
    Dim ws As Worksheet
    Dim pvTable As PivotTable
    For Each ws In ThisWorkbook.Worksheets
        For Each pvTable In ws.PivotTables
            With canPivotSourceParent 'All canPivotSourceParent is is an object of a class I created to make it easier to manage arrays (and arrays of arrays, for that matter).  This part of the code works, so this is not the issue.
                If .ArrayIndex(ws.Name) <> 0 Then '.ArrayIndex searches an array for a string, and if found, will return its index within the array.  Otherwise, it will return 0.  Again, this part of the code isn't the issue.
                    pvTable.RefreshTable 'and this does actually refresh pivot tables, as they initially start out being blank.
                End If
            End With
        Next pvTable
    Next ws
End Sub

Private Sub RefreshAllPivots()
    Dim pvtCache As PivotCache
    For Each pvtCache In ThisWorkbook.PivotCaches
        pvtCache.Refresh
    Next pvtCache
End Sub

Private Sub CopyPivots()
    Dim WB As Workbook
    Set WB = Application.Workbooks.Add
    Dim ws As Worksheet
    Dim pvTable As PivotTable
    For Each ws In cwtMain.wBook.Worksheets
        For Each pvTable In ws.PivotTables
            If canPivotSourceParent.ArrayIndex(ws.Name) = 0 Then
                ws.Copy before:=WB.Sheets(1)
            End If
        Next pvTable
    Next ws
    
    For Each ws In WB.Worksheets
        If IsWSheetBlank(ws) = True Then
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
End Sub

Private Function IsWSheetBlank(ws As Worksheet) As Boolean
    IsWSheetBlank = True
    Dim rngCell As Range
    For Each rngCell In ws.UsedRange
        If rngCell(1, 1) <> "" Then
            IsWSheetBlank = False
            Exit For
        End If
    Next rngCell
End Function
Regards,

William