Sub Somme()
Dim t1, t2, d As Object, t, i&, x$, tablo(), s, C
t1 = Range("B5:D" & [B65536].End(xlUp).Row)
t2 = Range("G5:I" & [G65536].End(xlUp).Row)
Set d = CreateObject("Scripting.Dictionary")
For Each t In Array(t1, t2) 'tableau de tableaux
For i = 1 To UBound(t)
x = t(i, 1) & Chr(1) & t(i, 2)
d(x) = d(x) + t(i, 3)
Next i
Next t
ReDim tablo(d.Count, 2)
i = 0
For Each C In d.keys
s = Split(C, Chr(1))
tablo(i, 0) = s(0)
tablo(i, 1) = s(1)
tablo(i, 2) = d(C)
i = i + 1
Next C
Range(Cells(5, 11), Cells(5, 11).End(4)(1, 3)).ClearContents
Cells(5, 11).Resize(UBound(tablo, 1), UBound(tablo, 2) + 1) = tablo
End Sub