Synchroniser Drill Down entre plusieurs tcd

Bonjour, je cherche à synchroniser mes Drill Down entre plusieurs tcd. Quelqu'un aurait la solution svp ? Je continue de chercher et vous préviens si j'y arrive de mon côté.
Merci de votre attention

Bonjour à tous !

Cette demande est, en contravention de la charte, multi-postée (a minima 3 forums).

Bonjour,

Je ne comprends pas, nous n'avons pas le droit de demander sur d'autres sites ?

Bonjour,

Je ne comprends pas, nous n'avons pas le droit de demander sur d'autres sites ?

Si, mais le cross-posting n'est jamais bien perçu et au vu de votre question vous n'avez probablement pas pris un peu de temps pour lire ces quelques lignes lors de votre inscription --> La charte --> Autres règles à respecter
Tout étant entendu, que si vous lisez la charte des autres forums vous y verrez une mention allant dans le même sens.

Merci de votre compréhension

Cordialement

D'accord excuser-moi je saurais pour les prochaines fois. Voici ce que j'ai fait pour le drill up, je me penche maintenant sur le drill down

Sub SynchroDrillUp()
    Dim ws As Worksheet
    Set ws = Worksheets("Feuil2")

    Dim ptNames() As String
    Dim ptLevels() As Integer
    Dim ptCount As Integer
    ptCount = ws.PivotTables.Count

    If ptCount = 0 Then Exit Sub

    ReDim ptNames(1 To ptCount)
    ReDim ptLevels(1 To ptCount)

    Dim i As Integer
    i = 1
    Dim pt As PivotTable

    For Each pt In ws.PivotTables
        Dim intLevel As Integer
        intLevel = 1
        Dim objPF As PivotField
        For Each objPF In pt.PivotFields
            If objPF.CubeField.CubeFieldType = xlHierarchy Then
                If objPF.Orientation = xlRowField Or objPF.Orientation = xlColumnField Then
                    ptNames(i) = pt.Name
                    ptLevels(i) = intLevel
                    Exit For
                End If
                intLevel = intLevel + 1
            End If
        Next objPF
        i = i + 1
    Next pt

    Dim levelCounts As Object
    Set levelCounts = CreateObject("Scripting.Dictionary")

    For i = 1 To ptCount
        If Not levelCounts.Exists(ptLevels(i)) Then
            levelCounts.Add ptLevels(i), 1
        Else
            levelCounts(ptLevels(i)) = levelCounts(ptLevels(i)) + 1
        End If
    Next i

    Dim uniqueLevel As Variant
    uniqueLevel = -1

    Dim levelKey As Variant
    For Each levelKey In levelCounts.Keys
        If levelCounts(levelKey) = 1 Then
            uniqueLevel = levelKey
            Exit For
        End If
    Next levelKey

    If uniqueLevel <> -1 Then
        Dim uniqueIndex As Integer
        For i = 1 To ptCount
            If ptLevels(i) = uniqueLevel Then
                uniqueIndex = i
                Exit For
            End If
        Next i

        Dim isLower As Boolean
        isLower = True

        For i = 1 To ptCount
            If i <> uniqueIndex Then
                If ptLevels(uniqueIndex) >= ptLevels(i) Then
                    isLower = False
                    Exit For
                End If
            End If
        Next i

        If isLower Then
            For i = 1 To ptCount
                If i <> uniqueIndex Then
                    DrillUpAllItems ptNames(i)
                End If
            Next i
        End If
    End If
End Sub

Sub DrillUp(pvtTableName As String)
    Dim pvtTable As PivotTable
    Set pvtTable = ActiveSheet.PivotTables(pvtTableName)

    Dim pvtField As PivotField
    For Each pvtField In pvtTable.PivotFields
        If pvtField.Orientation = xlRowField Or pvtField.Orientation = xlColumnField Then
            Dim pvtItem As PivotItem
            For Each pvtItem In pvtField.PivotItems
                pvtTable.DrillUp pvtItem
            Next pvtItem
        End If
    Next pvtField
End Sub