Sub DoublonsTotal() 'adapté de http://boisgontierjacques.free.fr/fichiers/Cellules/DoublonsTotal.xls
Set d = CreateObject("Scripting.Dictionary")
For Each c In Range("a2", Range("A" & Rows.Count).End(xlUp))
d(c.Value) = d(c.Value) + c.Offset(, 1).Value
Next c
[A2:B1000].ClearContents
[a2].Resize(d.Count, 1) = Application.Transpose(d.keys)
[b2].Resize(d.Count, 1) = Application.Transpose(d.items)
End Sub