Private Sub CommandButton1_Click()
Dim Dico1, Dico2, Dico3, Dico4, Dico5, Dico6, Dico7, Dico8, i As Integer, Tablo1, Tablo2
Tablo1 = Worksheets("J1").Range("A41:I52")
Tablo2 = Worksheets("J2").Range("A26:I37")
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set Dico3 = CreateObject("Scripting.Dictionary")
Set Dico4 = CreateObject("Scripting.Dictionary")
Set Dico5 = CreateObject("Scripting.Dictionary")
Set Dico6 = CreateObject("Scripting.Dictionary")
Set Dico7 = CreateObject("Scripting.Dictionary")
Set Dico8 = CreateObject("Scripting.Dictionary")
For i = LBound(Tablo1, 1) To UBound(Tablo1, 1)
Dico1(Tablo1(i, 1)) = Tablo1(i, 2)
Dico2(Tablo1(i, 1)) = Tablo1(i, 3)
Dico3(Tablo1(i, 1)) = Tablo1(i, 4)
Dico4(Tablo1(i, 1)) = Tablo1(i, 5)
Dico5(Tablo1(i, 1)) = Tablo1(i, 6)
Dico6(Tablo1(i, 1)) = Tablo1(i, 7)
Dico7(Tablo1(i, 1)) = Tablo1(i, 8)
Dico8(Tablo1(i, 1)) = Tablo1(i, 9)
Next
For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
If Not Dico8.exists(Tablo2(i, 1)) Then MsgBox Tablo2(i, 1)
Tablo2(i, 2) = Tablo2(i, 2) + Dico1(Tablo2(i, 1))
Tablo2(i, 3) = Tablo2(i, 3) + Dico2(Tablo2(i, 1))
Tablo2(i, 4) = Tablo2(i, 4) + Dico3(Tablo2(i, 1))
Tablo2(i, 5) = Tablo2(i, 5) + Dico4(Tablo2(i, 1))
Tablo2(i, 6) = Tablo2(i, 6) + Dico5(Tablo2(i, 1))
Tablo2(i, 7) = Tablo2(i, 7) + Dico6(Tablo2(i, 1))
Tablo2(i, 8) = Tablo2(i, 8) + Dico7(Tablo2(i, 1))
Tablo2(i, 9) = Tablo2(i, 9) + Dico8(Tablo2(i, 1))
Next
Worksheets("J2").Range("A41").Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)) = Tablo2
Worksheets("J2").Range("A41:I52").Sort Key1:=Range("B41"), Order1:=xlDescending
End Sub