Ещё вариант, сортирующий по первой последовательности цифр в названии листа. Комбинируйте и добьётесь того, чего нужно
Public Sub SortSheets(ByVal inBook As Excel.Workbook)
Dim RegExp As Object, i As Long, sName As String
Dim sortSheet As Excel.Worksheet
Dim vData() As Variant, regAnsweer As Object
Dim sortRange As Excel.Range, sortData As Variant
Application.ScreenUpdating = False
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Pattern = "\d+"
ReDim vData(1 To inBook.Worksheets.Count + 1, 1 To 2)
vData(1, 1) = "sheetName": vData(1, 2) = "Number"
Set sortSheet = inBook.Worksheets.Add(Before:=inBook.Worksheets(1))
For i = 2 To inBook.Worksheets.Count
sName = inBook.Worksheets(i).Name: vData(i, 1) = sName
Set regAnsweer = RegExp.Execute(sName)
If regAnsweer.Count > 0 Then vData(i, 2) = CLng(regAnsweer(0).Value)
Next i
Set sortRange = sortSheet.Range(sortSheet.Cells(1, 1), sortSheet.Cells(UBound(vData, 1), 2))
sortRange.Value = vData
sortRange.Sort Key1:=sortSheet.Range("B1"), Order1:=xlAscending, Header:=xlYes, DataOption1:=xlSortNormal
sortData = sortSheet.Range(sortSheet.Cells(2, 1), sortSheet.Cells(UBound(vData, 1), 1)).Value
For i = 1 To UBound(sortData, 1)
inBook.Worksheets(sortData(i, 1)).Move Before:=sortSheet
Next i
Application.DisplayAlerts = False
sortSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
