Sleeper: Looping through pivot (and copying data to another sheet)

[megaheinz]

Dear community
I have attached an example of pivot and VBA code which loops w/o problem through a pivot table and copies data, in this case for the pivotfield "Basin" into another table.
I just would like the same but not on "Basin", but "ProductGroup".
By changing the relevant codes, it does not work.
I am beginner of VBA, so my apologies.

Furthermore I would be glad to have a solution that after the looping is completed, it returns back to "(All)" in the case of existing/attached file and same (to "ProductGroup") if it loops through "ProductGroup" in the changed file.

Thank you for any support.

Best regards
Heinz

[June7]

Trying to understand workbook's behavior but really lost. Where is the code that fails?

Do need to end a copy/paste operation with:

Application.CutCopyMode = False

Then can set focus wherever you want.

[megaheinz]

Dear VBAX Tutor, Thank you for your reply
I reuploaded a file (Example11bis) with changed VBA code.
VBA code in previous file was working BUT I do not want anymore to loop through "Basin" but "ProductGroup". By changing "Basin" by "ProductGroup" VBA doesn't work anymore - with old and new code. Error in CurrentPage...
To solve this, I ask for support. Thank you very much.

[Aussiebear]

Where does one find the pivot field "Product Group"?

[p45cal]

You must tell us where you've cross posted to:
https://www.excelforum.com/excel-pro...her-sheet.html
see: https://excelguru.ca/a-message-to-forum-cross-posters/

Try something like:

Sub blah()
Summary_Start = 2
Set ProdGrp = Sheets("Pivot").PivotTables("PivotTable1").PivotFields("ProductGroup")
Set pitms = ProdGrp.PivotItems
For Each pitm In pitms
  pitm.Visible = True
  For Each pitm2 In pitms
    If pitm2.Name <> pitm.Name Then pitm2.Visible = False
  Next pitm2
  For j = 3 To 6
    Sheets("GAP").Range("D" & j + Grange & ":K" & j + Grange).Copy
    Sheets("Summary").Range("A" & Summary_Next + Summary_Start) = pitm.Name
    Sheets("Summary").Range("B" & Summary_Next + Summary_Start).PasteSpecial Paste:=xlPasteValues
    Grange = Grange + 3
    Summary_Start = Summary_Start + 18
  Next j
  Grange = 0
  Summary_Start = 2
  Summary_Next = Summary_Next + 1
Next pitm
ProdGrp.ClearAllFilters
End Sub

[June7]

See post #2 for additional code edit.

[megaheinz]

See post #2 for additional code edit.

Thanks a lot, code works well.

[megaheinz]

Where shall I tell you the cross posting websites (in fact the one that you already found and another German website/in German)?
https://www.clever-excel-forum.de/Th...zu-durchlaufen

[June7]

I it is considered a courtesy when posting to multiple forums to indicate so in original post and to provide links.