Excel 数据透视表报表筛选器

Question

Fed by powerquery queries I have a main Pivot table (2.5+m lines, so not loaded to the sheet nor the data model as I want to use report filters). Using the "show report filter pages" I split this pivot in multiple subsheets that I export and redistribute. The problem is that even the subsheets get the full datasource :(, so I'm stuck with:

1. Edit the query, add filter, refresh the pivot an all this for each entity (cumbersome option).
2. Give a pivot with the full source to all entities (not an option).
3. Uncheck the "save source data with file" (now the pivot is not editable anymore for the entities).

Basically I just need to be able to interact with the pivot source trough vba but based on my research this is not possible without refreshing all queries (option 1). Alternatively, I could fall back on loading to the dataModel, copy the pivot with vba but then it seems I cannot "remove lines" trough vba in the dataModel.

Any other ideas? I cannot believe I'm the only one that finds it stupid that the report filter is not also filtering the pivot source, seems logic to me.

Many thanks,

Demo file

Answer 1

You can use the below code to generate a separate sheet for each country. This creates sheets similar to "show report filter pages", but pastes data as plain text.

This is based on the sample sheet provided and if sheets with same name alrady exist it doesn't work right now. But you can add a condition to check the same

Sub SplitPivot()

Set pvtTable = Worksheets("pivot").PivotTables("PivotTable47")

For Each pvtitem In pvtTable.PivotFields("countries").PivotItems

    pvtTable.PivotFields("countries"). _
        ClearAllFilters
    pvtTable.PivotFields("countries").CurrentPage = pvtitem.Name
    Application.CutCopyMode = False
    pvtTable.PivotSelect "", xlDataAndLabel, True
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ' Sheets("Sheet5").Select
    ActiveSheet.Name = pvtitem.Name
    
    MsgBox pvtitem.Name & " Done"
        
Next

End Sub