Looping through pivot (and copying data to another sheet)

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

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

Do need to end a copy/paste operation with:

Code:

---

Application.CutCopyMode = False

---

Then can set focus wherever you want.

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.

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

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:

Code:

---

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

---

See post #2 for additional code edit.

Quote:

---

Originally Posted by June7

See post #2 for additional code edit.

---

Thanks a lot, code works well.

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

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