Option Explicit
Sub DeleteOldItemsWB()
'Effacer les Items non utilisés dans un TCD
'Debra Dalgleish - Basé sur MSKB (202232)
Dim WS As Worksheet
Dim PT As PivotTable
Dim PF As PivotField
Dim PI As PivotItem
Dim i As Integer
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
Next
Next
Next
Next
End Sub