Private Sub Worksheet_Activate()
Dim ncolcopie, tablo, resu(), d1 As Object, d2 As Object, i&, x$, y$, n&, j%
ncolcopie = 8 'modifiable, au moibs 8
tablo = Feuil1.[A1].CurrentRegion.Resize(, 11).Offset(1) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncolcopie)
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo) - 1
x = tablo(i, 7): y = x & tablo(i, 11)
If d1.exists(x) Then
If Not d2.exists(y) Then resu(d1(x), 8) = resu(d1(x), 8) + tablo(i, 8)
Else
n = n + 1
For j = 1 To ncolcopie: resu(n, j) = tablo(i, j): Next
d1(x) = n 'mémorisation de la ligne
End If
d2(y) = ""
Next
If n Then [A2].Resize(n, ncolcopie) = resu 'restitution
Rows(n + 2 & ":" & Rows.Count).ClearContents 'RAZ en dessous
End Sub