Speed up creating worksheets for all filters in pivot table

[hdinkie]

Hi members,

I have a workbook for which i want to create new worksheets for every item in the filter selection.
Since i want to modify the created worksheets and only keep the values and not the pivot itself, i created a code which seems to work, but is quite slowly.

Is there a way how i can speed up this code?

Sub GenerateWS()
 
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem
 
Application.ScreenUpdating = False

'1)Worksheet name where PIVOT Table is located
MyWs = "Pivot"
'2)PIVOT table name/number, note by default the first one created is PivotTable1
MyPIV = "PivotTable1"
'3)Field Name that you want to use for breaking out by, i.e. the filter name
MyField = "File name"
 
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
 
For Each PI In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
PI.Visible = True
 
For Each PI2 In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2
Set NewWs = Worksheets.Add
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
NewWs.Name = PI
 

'You will need to amend the range below to copy the correct amount of data for your file
Worksheets(MyWs).Select
    Range("B4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

'This pastes into cell A1 of the new sheet
NewWs.Select

 Range("B5").Select
'ActiveSheet.xlPasteValuesAndNumberFormats
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.Zoom = 80

Next PI
End With
    Sheets("Sheet1").Activate
        Response = MsgBox("WS generated Successfully.", 64)
End Sub

I cannot seem to upload the file ....
The problem is that the following code

"For Each PI In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
PI.Visible = True

For Each PI2 In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2'"

is comparing each item to each other (>500 options), whilst i am sure that all the filters available, would always have to be generated.
Any suggestions?