Private Sub Worksheet_Change(ByVal Target As Range)
Dim LO As ListObject, P As Range, ncol%, Q As Range, tablo, d As Object, i&, x$, n&, a, j%
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each LO In ListObjects 'tableaux Excel structurés
Set P = LO.Range
ncol = P.Columns.Count
P.AutoFilter: P.AutoFilter 'si le tableau est filtré
P.Offset(, ncol).Resize(, Columns.Count - ncol - P.Column + 1).Delete xlToLeft 'RAZ à droite du tableau
Set Q = P.Offset(, ncol + 1)
tablo = P 'matrice, plus rapide
'---liste sans doublon---
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1))
If x <> "" And Not d.exists(x) Then d(x) = i 'mémorisation de la ligne
Next
n = d.Count + 1
If n > 1 Then
'---formules SOMME.SI---
a = d.keys
For i = 2 To n
tablo(i, 1) = a(i - 2)
For j = 2 To ncol
tablo(i, j) = "=SUMIF(" & P.Columns(1).Address & "," & Q(i, 1).Address & "," & P.Columns(j).Address & ")"
Next j, i
Q.Resize(n) = tablo '1ère restitution
'---élimination des zéros---
tablo = Q.Resize(n) 'matrice des valeurs, plus rapide
For i = 2 To n
For j = 2 To ncol
If tablo(i, j) = 0 Then tablo(i, j) = P(d(CStr(tablo(i, 1))), j)
Next j, i
Q.Resize(n) = tablo '2ème restitution (il n'y a plus de formules)
End If
'---mise en forme---
With Q.Resize(n)
.Interior.ColorIndex = 36 'jaune clair
.Borders.Weight = xlHairline 'bordures
With .Rows(1)
.Value = P.Rows(1).Value 'en-têtes
.Interior.ColorIndex = 44 'orange
.Font.Bold = True 'gras
End With
End With
Next
Application.EnableEvents = True 'réactive les évènements
End Sub