Pivot - alte Daten nur ein Worksheet

Sub DeleteOldPivotItemsWB()
'löschen von nicht mehr verwendeten Einträgen in Pivot-Tabellen
'basierend auf MSKB (Q202232)
'Quelle: Thomas Ramel
Dim wS              As Worksheet
Dim pt              As PivotTable
Dim pf              As PivotField
Dim pi              As PivotItem
On Error Resume Next
For Each wS In ActiveWorkbook.Worksheets
For Each pt In wS.PivotTables
pt.RefreshTable
For Each pf In pt.PivotFields
For Each pi In pf.PivotItems
If pi.RecordCount = 0 And _
Not pi.IsCalculated Then
pi.Delete
End If
Next
Next
Next
Next
End Sub

Das dauert aber ewig - 15 Minuten mit einer Datei mit 6 Pivottabellen.
Frage 1. geht das irgendwie schneller?
Frage 2. Habe versucht den Code nur auf das aktive worksheet umzuschreiben - bin aber gescheitert - wer weiß wie es geht wenn man es nur für das aktuelle Tabellenblatt oder gar nur für die aktuelle Pivottabelle geht auf der man steht?
Vielen Dank
Gruß
lobby007