Sub mrshkei()
Dim i As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    x1 = Application.WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, 8)), "<>" & "")
    x2 = Application.WorksheetFunction.CountIf(Range(Cells(i - 1, 1), Cells(i - 1, 8)), "<>" & "")
    x3 = Application.WorksheetFunction.CountIf(Range(Cells(i + 1, 1), Cells(i + 1, 8)), "<>" & "")
    x4 = Cells(i, 9)
If x1 > 0 And x2 = 0 And x3 <> 0 And x4 <> "" Then
    Range(Cells(i, 1), Cells(Cells(i, 1).End(xlDown).Row, 9)).Select
    ActiveWorkbook.Worksheets("Исх.").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Исх.").Sort.SortFields.Add Key:=Range(Cells(i, 9), Cells(Cells(i, 1).End(xlDown).Row, 9)), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Исх.").Sort
        .SetRange Range(Cells(i, 1), Cells(Cells(i, 1).End(xlDown).Row, 9))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End If
Next i
Application.ScreenUpdating = True
Range("A1").Select
End Sub

Sub SortRng()
Dim rng As Range
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
  For Each rng In Range("I7:I" & iLastRow).SpecialCells(2, 1).Areas
    If rng.Count > 1 Then
     Range(rng.Cells(1, -7), rng.Cells(rng.Count)).Sort key1:=rng.Cells(1), Order1:=xlAscending
    End If
  Next
End Sub