Option Explicit
Sub TEST()
Dim Brr, Z, i&, j%, M&, C%, N&, R&
Set Z = CreateObject("Scripting.Dictionary")
R = [A1].End(xlDown).Row
If R + 3 <= [A65536].End(3).Row Then
Range(Cells(R + 3, "A"), [A65536].End(3)).EntireRow.Delete
End If
Brr = Range([M2], [A65536].End(3))
For i = 1 To UBound(Brr)
M = 0
For j = 0 To 3
N = 0
For C = 2 To 4
N = N + Brr(i, j * 3 + C)
Brr(i, j * 3 + C) = ""
Next
Brr(i, j * 3 + C - 3) = N
If M < N Then
Z(Brr(i, 1)) = j + 1
M = N
End If
Next
Next
[O2].Resize(UBound(Brr), 1) = Application.Transpose(Z.Items)
Cells(R + 3, "A").Resize(UBound(Brr), 13) = Brr
End Sub
