Option Explicit
Sub Test()
   NumericSort Range("A1:A2222")          'Sortierbereich
End Sub


Sub NumericSort(rngSort As Range)
Dim myRegexp
Dim myArr()
Dim myKeyRng As Range                     'Hilfsspalte


Dim i As Long

Set myRegexp = CreateObject("vbscript.regexp")
myRegexp.Global = True
myRegexp.Pattern = "\D"

   myArr = rngSort
   
   For i = LBound(myArr) To UBound(myArr)
      myArr(i, 1) = myRegexp.Replace(myArr(i, 1), "")
   Next i

Set myRegexp = Nothing

Set myKeyRng = Cells(rngSort.Cells(1).Row, Columns.Count).End(xlToLeft).Offset(, 1)
Set myKeyRng = myKeyRng.Resize(UBound(myArr, 1), UBound(myArr, 2))
myKeyRng.Value = myArr

With ActiveSheet
   With .Sort
      With .SortFields
         .Clear
         .Add Key:=Range(myKeyRng.Address), _
         SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      End With
      .SetRange Range(Range(rngSort, myKeyRng).Address)
      .Header = xlGuess
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
   End With
End With

myKeyRng.Clear

End Sub