Macro_Custom Sort List

[Kate_1009]

Hello everybody!

I'm struggling to create a macro to sort my value data according to a specific custom order (first of all the ones with 0535, then 1606, 1632 and eventually 1607).

It needs to work for 5k lines.
Unfortunately when I try to record my macro, something gets wrong and the output does not work (below, I copy/paste it).

Could you please help me? Thanks a lot!

Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+q
'
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("B11: B 5000").Select
    Application.AddCustomList ListArray:=Array("0535", "1606", "1632", "1607")
    ActiveWorkbook.Worksheets("DB").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DB").Sort.SortFields.Add Key:=Range("F12:F1421"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "0535,1606,1632,1607", DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DB").Sort
        .SetRange Range("B11: B 1421")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub