Sub Сортировка()
    
    Dim sh As Worksheet
    Dim lr As Long, i As Long
    
    Application.ScreenUpdating = False
    Set sh = ActiveSheet
    'поиск последней строки с данными по столбцу "A"
    lr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    
    sh.Sort.Header = xlNo
    sh.Sort.SortFields.Clear
    sh.Sort.SortFields.Add Key:=sh.Rows(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    For i = 2 To lr
        sh.Sort.SortFields(1).ModifyKey Key:=sh.Rows(i)
        sh.Sort.SetRange sh.Range(sh.Cells(i, "F"), sh.Cells(i, "AD"))
        sh.Sort.MatchCase = False
        sh.Sort.Orientation = xlLeftToRight
        sh.Sort.Apply
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation
    
End Sub