[COLOR="DarkSlateGray"][B]Sub Macro1()
Application.AddCustomList ListArray:=Range("Q3:Q17")
Range("A4:F27").Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.DeleteCustomList ListNum:=Application.CustomListCount
End Sub[/B][/COLOR]