Sub test()
Dim dic As Object, a, i As Long, w(), n As Integer, y
Set dic = CreateObject("Scripting.dictionary")
dic.CompareMode = vbTextcompare
a = Range("c1",Range("c" & Rows.Count).End(xlUp)).Resize(,5).Value
For i = 1 To UBound(a,1)
If Not IsEmpty(a(i,1)) Then
If Not dic.exists(a(i,1)) Then
ReDim w(1 To 5)
w(1) = a(i,1)
For ii = 2 To 5
w(ii) = a(i,ii)
Next
dic.add a(i,1), w
Else
w = dic(a(i,1))
For ii = 2 To 5
w(ii) = Application.Sum(w(ii),a(i,ii))
Next
dic(a(i,1)) = w
End If
End If
Next
y = dic.items : Set dic = Nothing : Erase a
With Range("j1")
For i = 0 To UBound(y)
.Offset(i).Resize(,UBound(y(i)+1).Value = y(i)
Next
End With
end Sub