Sort Select Range: Either Find Column Header or Last Column:Last Row

I did not 'move up' the Grand Total row because the summary should remain at the bottom. To get it to move up, use this, which just removes the -1 from the .SetRange line:

Sub TestMacro2()
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("1:2").Find("Grand Total").Offset(2) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Intersect(Range("2:" & Cells(Rows.Count, "A").End(xlUp).Row), Range("A3").CurrentRegion)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

As a side note - merged cells and multiple rows of headers are things you should avoid in your workbook design.