Sub LaMacroQuiRegroupe()
Dim Zone, i As Long, MonDico
With Sheets("Test")
Zone = .Range("K8:O" & .Range("K65536").End(xlUp).Row)
Set MonDico = CreateObject("Scripting.Dictionary")
For i = LBound(Zone) To UBound(Zone)
MonDico(Zone(i, 1)) = MonDico(Zone(i, 1)) + Zone(i, 5)
Next
For i = 8 To .Range("K65536").End(xlUp).Row
.Cells(i, 16) = MonDico(CStr(.Cells(i, 11)))
Next
End With
On Error Resume Next
With Range("P8:P" & [P65536].End(xlUp).Row)
.Replace What:="0", Replacement:="", Lookat:=xlWhole
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub