Synchronisation de TCD via VBA

Sub MAJ_Graph_Demo()

Dim bob, bob2, bob3 As String

'Evite le clignotement de l'écran lors de la mise à jour du rapport
    Application.ScreenUpdating = False

'Nomme le filtre du rapport
    bob = Worksheets("TCD").PivotTables("TCD0").PivotFields("PERIMETRE") _
        .CurrentPage
    bob2 = Worksheets("TCD").PivotTables("TCD0").PivotFields("EMPLOI") _
        .CurrentPage
    bob3 = Worksheets("TCD").PivotTables("TCD0").PivotFields("ATELIER") _
        .CurrentPage
         
'Modifie le fitre du rapport dans les TCDs
    Worksheets("TCD").PivotTables("TCD1").PivotFields("PERIMETRE") _
        .CurrentPage = bob
    Worksheets("TCD").PivotTables("TCD1").PivotFields("EMPLOI" _
        .CurrentPage = bob2
    Worksheets("TCD").PivotTables("TCD1").PivotFields("ATELIER") _
        .CurrentPage = bob3
        

    
   
End Sub


[CODE]


cependant, ce code ne me permet pas de choisir plusieurs éléments par filtre ... Ce que je recherche ... 

Existe t il un code ?

Sub OneForAll()
Dim PT_MAIN As PivotTable
Dim PT As PivotTable
Dim PFN(), PF As Integer, P, I
 
ActiveWorkbook.RefreshAll
 
'table de référence
Set PT_MAIN = ActiveSheet.PivotTables("Tableau croisé dynamique1")
I = 1
 
'recuperer les noms de filtres inactifs
For PF = 1 To PT_MAIN.PivotFields("AA").PivotItems.Count
    If Not PT_MAIN.PivotFields("AA").PivotItems(PF).Visible Then
        'redimensionner pfn en fonction du nombre de filtres inactif sur le champ AA
        ReDim Preserve PFN(1 To I)  'preserve pour ne pas perdre les données précédemment inscrites
        'l'ajouter
        PFN(I) = PT_MAIN.PivotFields("AA").PivotItems(PF).Name
        I = I + 1   'on incrémente en prévision du prochain filtres inactif à ajouter
    End If
Next PF
 
'nb de filtre inactifs
On Error GoTo ShowAll
I = UBound(PFN)
On Error GoTo 0
 
'les appliquer sur les autres tables pivot
For Each PT In ActiveSheet.PivotTables
    'sauf si c'est la table pivot de référence
    If Not PT.Name = PT_MAIN.Name Then
        With PT
            'activation de la selection multiple
            PT.PivotFields("AA").EnableMultiplePageItems = True
            'on affiche tout les filtres disponibles
            For Each P In PT.PivotFields("AA").PivotItems
                P.Visible = True
            Next P
            'on désactive les filtres devant etre inactif
            If Not I = 0 Then
                For PF = 1 To I
                    PT.PivotFields("AA").PivotItems(PFN(PF)).Visible = False
                Next PF
            End If
        End With
    End If
Next PT
 
Exit Sub
 
ShowAll:
I = 0
Resume Next
 
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim pvt As PivotTable, i As Byte, y$
If Target <> PivotTables(1) Then Exit Sub
For Each pvt In ActiveSheet.PivotTables
    If pvt <> Target Then
        For i = 1 To Target.PageFields.Count
            Application.EnableEvents = False
            y = Target.PageFields(i).CurrentPage
            pvt.PageFields(i).CurrentPage = y
            pvt.RefreshTable
            Application.EnableEvents = True
        Next
    End If
Next
End Sub