Sub Sortierung()
Dim lngCLC As Long
Dim lngListExist As Long
Dim lngOC As Long
Dim vListArr As Variant
vListArr = Array("Rad", "Auto", "Tuer", "Auspuff")
lngListExist = Application.GetCustomListNum(vListArr)
If lngListExist > 0 Then
lngOC = lngListExist + 1
Else
Application.AddCustomList listArray:=vListArr
lngCLC = Application.CustomListCount
lngOC = lngCLC + 1
End If
Range("A:C").Sort Key1:=Range("B1"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=lngOC, _
MatchCase:=False, Orientation:=xlTopToBottom
If lngListExist = 0 Then Application.DeleteCustomList ListNum:=lngCLC
End Sub