Sub test()
Dim arr(), iarr$(), ikey
Dim lRow&, i&, j&, itxt$
With Sheets("Лист1")
    lRow = .Range("a" & .Rows.Count).End(xlUp).Row
    arr = .Range("a2:o" & lRow).Value
    .Range("a2:o" & lRow).ClearContents
End With
With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        itxt = ""
        For j = 1 To UBound(arr, 2)
            If j <> UBound(arr, 2) - 1 Then itxt = itxt & arr(i, j) & "|"
        Next j
        .Item(itxt) = .Item(itxt) & arr(i, UBound(arr, 2) - 1) & ", "
    Next i
    lRow = 0
    For Each ikey In .keys
        lRow = lRow + 1
        arr(lRow, UBound(arr, 2) - 1) = Left(.Item(ikey), Len(.Item(ikey)) - 2)
        iarr = Split(Left(ikey, Len(ikey) - 1), "|")
        For i = 0 To UBound(iarr)
            If i = UBound(iarr) Then _
                arr(lRow, UBound(arr, 2)) = iarr(i) Else arr(lRow, i + 1) = iarr(i)
        Next i
    Next ikey
End With
    Sheets("Лист1").Range("a2").Resize(lRow, UBound(arr, 2)) = arr
End Sub