Try
Sub test()
    Dim a, i As Long, ii As Long, e
    a = Sheets("before").Cells(1).CurrentRegion.Resize(, 16).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 6)) Then
                .Item(a(i, 6)) = .Count + 2
                For ii = 1 To UBound(a, 2)
                    a(.Count + 1, ii) = a(i, ii)
                Next
            Else
                For Each e In Array(14, 16)
                    a(.Item(a(i, 6)), e) = a(.Item(a(i, 6)), e) + a(i, e)
                Next
            End If
        Next
        i = .Count + 1
    End With
    Sheets.Add.Cells(1).Resize(i, UBound(a, 2)).Value = a
End Sub