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