Option Explicit
Sub test()
Dim a, i As Long, j As Long, n As Long, txt As String
a = Sheets(2).Range("a1").CurrentRegion.Value
n = 1
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(a, 1)
txt = Join(Array(a(i, 1), a(i, 2), a(i, 3), a(i, 4), a(i, 5), a(i, 10)), Chr(2))
If Not .exists(txt) Then
n = n + 1: .Item(txt) = n
For j = 1 To UBound(a, 2)
a(n, j) = a(i, j)
Next
Else
a(.Item(txt), 6) = a(.Item(txt), 6) + a(i, 6)
a(.Item(txt), 7) = a(.Item(txt), 7) + a(i, 7)
a(.Item(txt), 8) = a(.Item(txt), 8) + a(i, 8)
a(.Item(txt), 12) = a(.Item(txt), 12) + a(i, 12)
a(.Item(txt), 14) = a(.Item(txt), 14) + a(i, 14)
End If
Next
End With
With Sheets.Add().Cells(1).Resize(n, UBound(a, 2))
.Value = a
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
With .Rows(1)
.BorderAround Weight:=xlThin
.Interior.ColorIndex = 36
End With
.Columns.AutoFit
End With
End Sub