Sub Udal()
    Sort
    Application.ScreenUpdating = 0
    r0_ = 1
    c0_ = 1
    c_ = 3
    r1_ = Cells(Rows.Count, c0_).End(3).Row
    c1_ = Cells(r0_, Columns.Count).End(1).Column
    nr_ = r1_ - r0_ + 1
    nc_ = c1_ - c0_ + 1
    ar = Cells(r0_, c0_).Resize(nr_, nc_)
    For i = r1_ To r0_ + 1 Step -1
        fl_ = 1
        For j = 1 To nc_
            If j <> c_ Then
                If ar(i, j) <> ar(i - 1, j) Then
                    fl_ = 0
                    Exit For
                End If
            End If
        Next j
        If fl_ Then
            ar(i - 1, c_) = ar(i - 1, c_) + ar(i, c_)
            For j = 1 To nc_
                ar(i, j) = Empty
            Next j
        End If
    Next i
    Cells(r0_, c0_).Resize(nr_, nc_) = ar
    Sort
    Application.ScreenUpdating = 1
End Sub
Sub Sort()
    Application.ScreenUpdating = 0
    r0_ = 1
    c0_ = 1
    c_ = 3
    r1_ = Cells(Rows.Count, c0_).End(3).Row
    c1_ = Cells(r0_, Columns.Count).End(1).Column
    nr_ = r1_ - r0_ + 1
    nc_ = c1_ - c0_ + 1
    With ActiveSheet.Sort.SortFields
        .Clear
        For i = 1 To nc_
            If i <> c_ Then
                .Add Key:=Cells(r0_, c0_).Offset(, i - 1).Resize(nr_)
            End If
        Next i
        With .Parent
            .SetRange Cells(r0_, c0_).Resize(nr_, nc_)
            .Apply
        End With
    End With
End Sub