Sub es()
Dim t(), i As Long, m As Object, x As Long, z, c As Byte
Application.ScreenUpdating = 0
Set m = CreateObject("Scripting.Dictionary")
t = Range("a2:f" & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t)
z = t(i, 1) & t(i, 2)
If m.Exists(z) Then
t(m(z), 6) = t(m(z), 6) + t(i, 6)
Else
x = x + 1
For c = 1 To 6: t(x, c) = t(i, c): Next c: m(z) = x
End If
Next i
[h2].Resize(x, 6) = t
End Sub