Sub Consolider()
Const Base = "c4", Dest = "i4"
Dim t, i&, n&
Application.ScreenUpdating = False
Range(Dest).Resize(Rows.Count - Range(Dest).Row + 1, 2).Clear
t = Range(Range(Base), Cells(Rows.Count, Range(Base).Column).End(xlUp)).Resize(, 4)
For i = 1 To UBound(t): t(i, 1) = UCase(Trim(t(i, 1)) & Trim(t(i, 2)) & Trim(t(i, 3))): t(i, 2) = t(i, 4): Next
With Range(Dest).Resize(UBound(t), 2)
.Value = t
.Sort key1:=.Range("a1"), order1:=xlAscending, Header:=xlNo
t = .Value: n = 1
For i = 2 To UBound(t)
If t(i, 1) = t(n, 1) Then
t(n, 2) = t(n, 2) + t(i, 2)
Else
n = n + 1: t(n, 1) = t(i, 1): t(n, 2) = t(i, 2)
End If
Next i
.Clear: .Resize(n).Value = t
.Resize(n).Borders.LineStyle = xlContinuous
End With
End Sub