Hi,
I have a code that filters out every possible filter for a pivot table and copy specific values to other sheet.
It works fine, but it has suddenly crashed already twice.
It goes like this:
- Everything works fine;
- Suddenly, without any logic, error appears in a middle of code doing its work. It loops through approx. 40 filters out of 70 and then crashes;
- From now on, it will continue to crash at the same place;
- If I will copy all data and file structure to a new workbook and will apply the same code, it will again work (due this I don't see any logic, why the code crashes).
Any idea what this might be related to? New sheets added to workbook? New pivots created in a workbook?
Code below (yellow - line where error appears):
![]()
Sub Loop_PivotItems() 'Turn off screen updating Application.ScreenUpdating = False 'Store the sheet with the Pivot Table Piv_Sht = ActiveSheet.Name 'Loop through every PivotItem in the PageField (Filter) of the Pivot Table For Each PivotItem In ActiveSheet.PivotTables(1).PageFields(1).PivotItems 'Select the PivotItem ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value 'Copy data to other sheet Dim lr As Long Dim wsSource As Worksheet Dim wsDest As Worksheet Set wsSource = Sheets("Grafiks") Set wsDest = Sheets("Outcome") lr = wsDest.Cells(Rows.Count, "A").End(xlUp).Row + 1 wsDest.Range("A" & lr).Value = wsSource.Range("A4").Value wsDest.Range("B" & lr).Value = wsSource.Range("B4").Value wsDest.Range("C" & lr).Value = wsSource.Range("F4").Value wsDest.Range("D" & lr).Value = wsSource.Range("J4").Value 'Return to sheet with the Pivot Table Sheets(Piv_Sht).Select Next 'Turn on screen updating Application.ScreenUpdating = True End Sub
Bookmarks