Sub DoublonsTotal()
Set d = CreateObject("Scripting.Dictionary")
For Each c In Range("c4:c" & [c65000].End(xlUp).Row)
d(c.Value) = d(c.Value) + c.Offset(, 1).Value
Next c
[f4:g1000].ClearContents
[f4].Resize(d.Count, 1) = Application.Transpose(d.keys)
[g4].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub