Copie TCD en fonction de plusieurs paramètres

Bonjour à tous,

Vous sauriez pourquoi mon code bug au bout de 5/7 nouveaux onglets alors que les paramètres ne changent pas ?

Merci beaucoup pour votre aide.

Jean

PS: code ci-dessous

PS2: fichier en PJ

Sub Macro2()

Dim plage As Range
Dim i As Byte
Set plage = Sheets("DB").Range("A1:R" & Sheets("DB").Range("A" & Rows.Count).End(xlUp).Row)

For i = 2 To Sheets("DB").Range("AD" & Rows.Count).End(xlUp).Row

    Sheets("TCD").PivotTables("TCD").PivotSelect "", _
        xlDataAndLabel, True
    Selection.Copy

    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Paste

    ActiveSheet.PivotTables(1).Name = Sheets("DB").Range("AD" & i)
    ActiveSheet.Name = Sheets("DB").Range("AD" & i)

    With ActiveSheet.PivotTables(ActiveSheet.Name)
        .PivotFields("TBD_MAINDESC").CurrentPage = ActiveSheet.Name
    End With

Next
End Sub

Pour ceux qui veulent, voici le code qui fonctionne:

Sub Macro2()

Dim plage As Range
Dim i As Byte
Dim TCD As PivotTable

For i = 2 To Sheets("DB").Range("AD" & Rows.Count).End(xlUp).Row

    Set TCD = Worksheets("TCD").PivotTables("TCD")

    TCD.PivotSelect "", xlDataAndLabel, True
    Selection.Copy

    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = Sheets("DB").Range("AD" & i)

    ActiveSheet.Range("A1").PasteSpecial
    ActiveSheet.PivotTables(1).Name = Sheets("DB").Range("AD" & i)

    With ActiveSheet.PivotTables(ActiveSheet.Name)
        .PivotFields("TBD_MAINDESC").CurrentPage = ActiveSheet.Name
    End With

Next
End Sub

NB: il faut sélectionner, dans le TCD source, le filtre (tous) sinon cela ne fonctionne pas.

Jean