Группирование строк в EXCEL (макрос) / VBA

Формулировка задачи:

Ребят, добрый день!! Помогите, пожалуйста,написать макрос, чтобы в таблице EXCEL строки автоматом группировались по одинаковым названиям в каждом столбце (их 4). Т.е. сбоку слева появлялся "плюсик" и можно было группу свернуть или развернуть. В первом столбце названия групп повторяются и группа заканчивается со словом ГРУППА_ИТОГ. Мне нужно сделать по каждому столбцу группировку. Файл с примером во вложении Перерыла весь инет, не нашла

Решение задачи: «Группирование строк в EXCEL (макрос) / VBA»

textual
                            Листинг программы 
                        
 
                            
                        
Sub PodItogi2()
  ' Многоуровневые итоги
  Dim iLastRow As Long, WkSh As Worksheet
  Set WkSh = Worksheets("Город")
  With WkSh
   .AutoFilterMode = False
   .Cells.RemoveSubtotal
   iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
   With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Parent.Range("A6:A" & iLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Parent.Range("B6:B" & iLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Parent.Range("C6:C" & iLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Parent.Range("D6:D" & iLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange WkSh.Range("A5:H" & iLastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    .Range("A5:H" & iLastRow).RemoveSubtotal
    .Range("A5:H" & iLastRow).Subtotal GroupBy:=Array(1, 2, 3, 4), Function:=xlSum, TotalList:=Array(7, 8), _
    Replace:=False, PageBreaks:=False, SummaryBelowData:=False
    .Range("A5:H6").AutoFilter
  End With
End Sub