Sub SortMultipleColumns()
'www.Tricks12345.com
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Report").Delete
Dim InputSH As Worksheet
Set InputSH = ThisWorkbook.Sheets("Input")
ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Report"
Dim ReportSH As Worksheet
Set ReportSH = ThisWorkbook.Sheets("Report")
'Key denotes about first sort field
InputSH.Range("A1").CurrentRegion.Copy ReportSH.Range("A1")
ReportSH.Sort.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
'ReportSH.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
' Custom Sort
ReportSH.Sort.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, _
CustomOrder:="Apple, Orange, Grapes, Banana, Pineapple", DataOption:=xlSortNormal
LastRow = ReportSH.Range("A" & Rows.Count).End(xlUp).Row
With ReportSH.Sort
.SetRange Range("A1:C" & LastRow)
.Header = xlYes 'Data consists of Header or not
.MatchCase = False ' True for case sensitive, false for noncase sensitive
.Orientation = xlTopToBottom ' Denotes where sort is in ascending or descending
.SortMethod = xlPinYin ' Excel supports chinese language also
.Apply
End With
ReportSH.UsedRange.Columns.AutoFit
End Sub