Sub SortSheets()
Dim iSh As Worksheet
Dim arr(), arrSort(), I&
ReDim arr(Worksheets.Count - 1)
On Error Resume Next
For Each iSh In Worksheets
    arr(I) = CDbl(iSh.Name)
    I = I + 1
Next
arrSort = ShellSort(arr)
Application.ScreenUpdating = False
For I = 0 To UBound(arrSort)
    Worksheets(CStr(arrSort(I))).Move Before:=Sheets(I + 1)
Next
Worksheets(1).Activate
Application.ScreenUpdating = True
End Sub

Function ShellSort(x) '*** для 1-мерного массива
Dim Limit As Long, Switch As Long, I As Long, j As Long
Dim tmp
j = (UBound(x) - LBound(x) + 1) \ 2
Do While j > 0
 Limit = UBound(x) - j
 Do
 Switch = LBound(x) - 1
 For I = LBound(x) To Limit
 If x(I) > x(I + j) Then 'по возрастанию
' If x(i) < x(i + j) Then 'по убыванию
 tmp = x(I): x(I) = x(I + j)
 x(I + j) = tmp: Switch = I
 End If
 Next
 Limit = Switch - j
 Loop While Switch >= LBound(x)
 j = j \ 2
Loop
ShellSort = x
End Function