Sub Сортировка()
    
    Dim sh As Worksheet, rngTotal As Range, rngBlue As Range, rngWhite As Range
    Dim rngFind As Range, lr As Long
    
    Set sh = ActiveSheet
    lr = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
    Set rngTotal = sh.Range("A2:A" & lr)
    
    Application.FindFormat.Clear
    Application.FindFormat.Interior.Color = 16777215
    Set rngFind = rngTotal.Find(What:="", After:=rngTotal.Cells(rngTotal.Cells.Count), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
        
    If rngFind Is Nothing Then
        Set rngBlue = rngTotal
    Else
        If rngFind.Row = 2 Then
            Set rngWhite = rngTotal
        Else
            Set rngBlue = sh.Rows("2:" & rngFind.Row - 1).Columns("A:B")
            Set rngWhite = sh.Rows(rngFind.Row & ":" & lr).Columns("A:B")
        End If
    End If
    
    If Not rngBlue Is Nothing Then
        sh.Sort.SortFields.Clear
        sh.Sort.Header = xlNo
        sh.Sort.SortFields.Add key:=sh.Columns("A"), Order:=xlDescending
        sh.Sort.SetRange rngBlue
        sh.Sort.Apply
    End If
    
    If Not rngWhite Is Nothing Then
        sh.Sort.SortFields.Clear
        sh.Sort.Header = xlNo
        sh.Sort.SortFields.Add key:=sh.Columns("A"), Order:=xlAscending
        sh.Sort.SetRange rngWhite
        sh.Sort.Apply
    End If
    
End Sub