TCD qui se chevauchent (pivot table overlapping)

Bonjour à tous,

Je pose une question déjà posée plusieurs fois, mais pour laquelle je cherche une réponse un peu différente ...

J'ai parfois plusieurs TCD sur une seule feuille de calcul (mauvaise idée, je sais, mais il m'est difficile de faire autrement ...)

Evidemment, parfois les TCD se marchent sur le pieds, et il faut beaucoup de temps pour trouver le responsable (puisque Excel rafraîchit tous les TCD en une fois ...)

En fait je cherche une Macro qui ferai le job de debug, pour m'aider dans la correction.

J'ai trouvé différents exemples, mais aucun ne fonctionne :

Celui ci ci me dit que tout va bien ...

Sub FindPivotOverlaps() 'Pour detecter un TCD en défaut

Dim ws As Worksheet
Dim pt              As PivotTable
Dim pt2             As PivotTable
Dim lo              As ListObject
Dim rOffset         As Range
Dim cell            As Range
Dim sMsg            As String

For Each ws In ActiveWorkbook.Worksheets
    For Each pt In ws.PivotTables
        With pt.TableRange2
            Set rOffset = Union( _
                                .Offset(pt.TableRange2.Rows.Count, 0).Resize(1), _
                                .Offset(0, pt.TableRange2.Columns.Count).Resize(pt.TableRange2.Rows.Count, 1))
        End With
        'Test for ListObject collision
        Set lo = Nothing
        On Error Resume Next
        Set lo = rOffset.ListObject
        On Error GoTo 0
        If Not lo Is Nothing Then
            sMsg = sMsg & lo.Name & vbTab & "'" & lo.Parent.Name & "'!" & lo.DataBodyRange.Address & vbNewLine
        Else
            'Test for PivotTable collision
            For Each cell In rOffset
                Set pt2 = Nothing
                On Error Resume Next
                Set pt2 = cell.PivotTable
                On Error GoTo 0
                If Not pt2 Is Nothing Then
                    sMsg = sMsg & pt2.Name & vbTab & "'" & pt2.Parent.Name & "'!" & pt2.TableRange2.Address & vbNewLine
                    Exit For
                End If
            Next cell
        End If

    Next pt
Next ws

If sMsg = "" Then sMsg = "No overlaps found!"
MsgBox sMsg

End Sub

Celui-ci bug avant de se lancer :

Sub M_snb() 'Check TCD overlap
For Each it In Sheets
    ReDim sn(it.ListObjects.Count + it.PivotTables.Count - 1)
    If UBound(sn) > -1 Then
            sn(0) = IIf(it.ListObjects.Count > 0, it.ListObjects(1).Range.Address, it.PivotTables(1).TableRange2.Address)
        For j = 2 To UBound(sn) + 1
            If j = it.ListObjects.Count Then Set c00 = it.PivotTables(j - it.ListObjects.Count).TableRange2
            For jj = 0 To UBound(sn)
                If IsEmpty(sn(jj)) Then Exit For
                If Not Intersect(Range(sn(jj)), c00) Is Nothing Then Exit For
            Next
            If IsEmpty(sn(jj)) Then
                sn(jj) = c00.Address
            ElseIf jj <= UBound(sn) Then
                MsgBox "Overlap " & sn(jj) & vbTab & c00.Name, , it.Name
                Exit Sub
            End If
        Next
        MsgBox Join(sn, vbLf), , it.Name & " no overlap"
    End If
Next
End Sub

si quelqu'un a une solution, je le remercie bien bas d'avance, et je suis sur que je ne serais pas le seul ...

Merci à tous,