Sub MySort()
'  Description: сортирует строки внутри подгруппы

Dim fRow&, i&
Dim iRow&: iRow = 2
Dim Arr()
    Do While Cells(iRow, 1) <> ""
        iRow = iRow + 1
        fRow = iRow 'запоминаем строку начала массива
        ReDim Arr(1 To 4, 1 To 1)
        For i = 1 To 100    '100 - максимально допустимое количество значений в выгрузке
            ReDim Preserve Arr(1 To 4, 1 To i)
            Arr(1, i) = Cells(iRow, 1)
            'второй столбец пропускаем, ибо пустой
            Arr(3, i) = Cells(iRow, 3)
            Arr(4, i) = Cells(iRow, 4)
            iRow = iRow + 1 'увеличиваем просматриваемую строку
            'если следующая строка 1-го уровня группировки, то выходим из цикла for
            If Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
        Next
        'заносим отсортированные значение на место старых
        Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), 4)    '4 - колонка по которой сортируем
    Loop
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&
Dim TmpMas1(1 To 4) As Variant
Dim TmpMas2(1 To 4) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To 4
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To 4
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function

Sub SortGroup() 'запускать с этого макроса
'сортировка групп
'' Written: 19.06.2018
Dim iRow&, lCol
    
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        iRow = .Cells(.Rows.Count, 1).End(xlUp).Row             'последняя заполненная строка
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
        If Not .AutoFilterMode Then .Range(.Cells(1, 1), .Cells(iRow, lCol)).AutoFilter 'включаем фильтр
        With .AutoFilter.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B1:B" & iRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    Call SortSubGroup
End Sub

Sub SortSubGroup()
'  Description: сортирует строки внутри группы
'' Written: 18.06.2018
Dim fRow&, i&, j&
Dim iRow&: iRow = 2
Dim Arr()
Dim maxRow&, maxCol&, SortCol&
    With ActiveSheet
    maxRow = WorksheetFunction.Max(.Columns(2))              'максимальное количество значений в группе
    maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
    SortCol = 4                    'колонка по которой сортируем строки в группе
        Do While .Cells(iRow, 1) <> ""
            iRow = iRow + 1
            fRow = iRow                    'запоминаем первую строку группы
            ReDim Arr(1 To maxCol, 1 To 1)
            For i = 1 To maxRow                             'цикл "по строкам"
                ReDim Preserve Arr(1 To maxCol, 1 To i)
                For j = 1 To maxCol                         'цикл "по колонкам"
                    Arr(j, i) = IIf(IsError(.Cells(iRow, j)), 0, .Cells(iRow, j))    ' есть сроки с ошибками, поэтому добавил бработку ошибок
                Next j
                iRow = iRow + 1                             'увеличиваем номер просматриваемой строки
                'если следующая строка 1-го уровня группировки, то выходим из цикла "по строкам"
                If .Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
            Next i
            'заносим отсортированные значение на место старых
            .Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), SortCol)
        Loop
    End With
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&, C&, TmpMas1(), TmpMas2()
C = UBound(Massiv, 2)
ReDim TmpMas1(1 To C) As Variant
ReDim TmpMas2(1 To C) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To C
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To C
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function