Sub eee()
    Lst = "Лист2"
    
    NLst = Sheets.Count
'    Sheets(Lst).Copy After:=Sheets(NLst)
    Sheets(Lst).Copy
    NLst = ActiveWorkbook.ActiveSheet.Name
    
    Range("C:C,E:E,F:F,H:H,I:I").Delete Shift:=xlToLeft
    
    Columns("B:B").Cut
    Columns("D:D").Insert Shift:=xlToRight
    
    NRow = Range("A2").End(xlDown).Row
    CNRow = CStr(NRow)
    
    ActiveWorkbook.Worksheets(NLst).Sort.SortFields.Clear
    
    With ActiveWorkbook.Worksheets(NLst).Sort
        .SortFields.Clear
        With .SortFields
        .Add Key:=Range("A2:A" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("B2:B" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("C2:C" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Add Key:=Range("D2:D" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        
        .SetRange Range("A1:F" + CNRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    FStr = ""
    NN = ""
    j = 0
    
    For i = 2 To NRow
        ii = CStr(i)
        TStr = CStr(Range("A" + ii)) + Range("B" + ii) + Range("C" + ii) + Range("D" + ii)
        If FStr = TStr Then
            Range("G" + ii) = 0
            Range("E" + NN) = Range("E" + NN) + Range("E" + ii)
            Range("F" + NN) = Range("F" + NN) + Range("F" + ii)
        Else
            NN = ii
            FStr = TStr
            j = j + 1
            Range("G" + ii) = j
        End If
    Next
    
    With ActiveWorkbook.Worksheets(NLst).Sort
        .SortFields.Clear
        With .SortFields
        .Add Key:=Range("G2:G" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        
        .SetRange Range("A1:G" + CNRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    j = 1
    For i = 2 To NRow
        If Range("G" + CStr(i)) = 0 Then
            j = i
        Else
            Exit For
        End If
    Next
    
    Range("G:G").Delete Shift:=xlToLeft
    If j <> 1 Then
        Rows("2:" + CStr(j)).Delete Shift:=xlUp
    End If
    
    Range("A1").Select

End Sub