Sub SlipttTCD()
Application.ScreenUpdating = False
Dim pvt As PivotField, i%, x%, y%, tablo, Mname$
With ActiveSheet.PivotTables("Tableau croisé dynamique1")
Set pvt = .PivotFields("Discipline sportive")
y = pvt.PivotItems.Count
x = 1
With pvt
Do
.PivotItems(x).Visible = True
For i = 1 To y
If i <> x Then .PivotItems(i).Visible = False
Next
tablo = Range("A5").CurrentRegion.Value
Workbooks.Add
With ActiveWorkbook
With .Sheets(1)
.Range("A1").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
Call Quadri
Mname = Range("A3")
End With
.SaveAs "C:\Temp\" & Mname & ".xls"
.Close
End With
x = x + 1
Loop Until x > y
End With
End With
End Sub