Option
Explicit
Sub
Test1234()
Dim
myCustomList
As
Variant
Dim
myCustomListIndex
As
Long
myCustomList = Array(
"H"
,
"A"
,
"B"
)
On
Error
Resume
Next
myCustomListIndex = 0
myCustomListIndex = Application.GetCustomListNum(myCustomList)
On
Error
GoTo
0
If
myCustomListIndex = 0
Then
Call
Application.AddCustomList(myCustomList)
myCustomListIndex = Application.GetCustomListNum(myCustomList)
End
If
With
ThisWorkbook.Worksheets(
"Tabelle1"
)
Dim
rngTable
As
Excel.Range
Set
rngTable = .Range(.Cells(.Rows.Count,
"A"
).
End
(xlUp),
"I1"
)
With
.Sort
With
.SortFields
.Clear
.Add2 Key:=rngTable.Columns(1), _
SortOn:=xlSortOnValues, _
Order:=XlSortOrder.xlAscending, _
DataOption:=XlSortDataOption.xlSortNormal
.Add2 Key:=rngTable.Columns(8), _
SortOn:=xlSortOnValues, _
Order:=XlSortOrder.xlAscending, CustomOrder:=myCustomListIndex, _
DataOption:=XlSortDataOption.xlSortNormal
.Add2 Key:=rngTable.Columns(7), _
SortOn:=xlSortOnValues, _
Order:=XlSortOrder.xlDescending, _
DataOption:=XlSortDataOption.xlSortNormal
End
With
.Orientation = xlTopToBottom
.Header = XlYesNoGuess.xlYes
.MatchCase =
False
.SortMethod = xlPinYin
Call
.SetRange(rngTable)
Call
.Apply
End
With
End
With
End
Sub