OK, try this
There's no real error checking to fail softly (like mis-spelling one of the categories), but checks can be added
Option Explicit
Sub SortBlocks()
Dim rCategory As Range
Application.ScreenUpdating = False
With ActiveSheet
Set rCategory = .Columns(2)
Call SortBlock(rCategory, "Auto Ancillaries")
Call SortBlock(rCategory, "Auto")
Call SortBlock(rCategory, "Banks")
End With
Application.ScreenUpdating = True
MsgBox "Sorted"
End Sub
Private Sub SortBlock(r As Range, s As String)
Dim rLastColumn As Range, rSort As Range, rStart As Range, rEnd As Range
With r
Set rStart = .Find(What:=s, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlWhole).Offset(1, 0)
Set rEnd = rStart.End(xlDown)
Set rLastColumn = .Parent.Cells(6, .Parent.Columns.Count).End(xlToLeft).EntireColumn
Set rSort = Range(rStart, Intersect(rEnd.EntireRow, rLastColumn))
End With
With r.Parent.Sort
.SortFields.Clear
.SortFields.Add Key:=rSort.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSort
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub