Sub СОРТИРОВКА()
Dim rn As Range
Dim vAdr1 As String
Dim vAdr2 As String
' НА ВСЯКИЙ СЛУЧАЙ АКТИВИРУЕМ ПЕРВУЮ ЯЧЕЙКУ
Cells(1, 1).Select
' НАХОДИМ ПЕРВУЮ ЯЧЕЙКУ СО СЛОВОМ ОПЕРАЦИЯ
Cells.Find(What:="Операция", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr1 = Selection.Address
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
' ЦИКЛ
Do
' ПРОДОЛЖАЕМ ПОИСК ДАЛЕЕ
Cells.FindNext(After:=ActiveCell).Select
' ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr2 = Selection.Address
' СРАВНИВАЕМ ПЕРЕМЕННЫЕ (ЕСЛИ СОВПАДАЮТ С АДРЕСОМ ПЕРВОЙ НАЙДЕННОЙ ЯЧЕЙКИ ОСТАНАВЛИВАЕМ ЦИКЛ)
If Not vAdr1 <> vAdr2 Then Exit Do
' ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
' И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
' ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = "dd.mm.yyyy"
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = "hh:mm:ss"
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

'??????

' СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Sub СОРТИРОВКА()
Dim r As Range, adr$
Set r = Sheets("Report").UsedRange.Find("Операция", LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
    adr = r.Address
    Do
        With r.CurrentRegion
            With .Resize(.Rows.Count - 1)
                .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
                      Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
        Set r = Sheets("Report").UsedRange.FindNext(r)
    Loop While r.Address <> adr
End If
End Sub