按名称对工作表进行排序

Sub SortSheetByName()
    Dim intSheetCount As Integer
    Dim i As Integer, j As Integer
    Dim strName As String, astrSheet() As String
    '关闭屏幕刷新，提升运行速度
    Application.ScreenUpdating = False
    '获取工作表的数量并赋值给变量
    intSheetCount = Worksheets.Count
    '将动态数组调整为一维数组
    ReDim astrSheet(1 To intSheetCount)
    '将全部工作表名称保存在数组
    For i = 1 To intSheetCount
        astrSheet(i) = Worksheets(i).Name
    Next i
    '按从大到小的顺序对数组排序
    For i = 1 To intSheetCount - 1
        For j = i + 1 To intSheetCount
            '将数组中相邻的两个数据进行比较，如果前一个数据比后一个数据小，则交换位置
            If astrSheet(i) < astrSheet(j) Then
                strName = astrSheet(i)
                astrSheet(i) = astrSheet(j)
                astrSheet(j) = strName
            End If
        Next j
    Next i
    '按排序后的数组顺序逐一移动工作表到第1个工作表之前
    For i = 1 To intSheetCount
        Worksheets(astrSheet(i)).Move Before:=Worksheets(1)
    Next i
    '开启屏幕刷新
    Application.ScreenUpdating = True
End Sub

Move (Before, After)

Sub SortSheetByNumber()
    '冒泡法排序工作表名
    Dim arr, i%, j%, tempVal
    Dim intSheetCount As Integer
    Application.ScreenUpdating = False
    intSheetCount = Worksheets.Count '工作表数量
    ReDim arr(1 To intSheetCount, 1 To 2) '重定义二维数组
    '二维数组赋值
    For i = 1 To intSheetCount
        arr(i, 1) = Worksheets(i).Name '工作表名
        arr(i, 2) = Val(GetNumber(Worksheets(i).Name)) '工作表名中的数值
    Next i
    '冒泡法排序，相邻两个值比较，大的上浮，小的下沉
    For i = UBound(arr) To LBound(arr) + 1 Step -1
        For j = LBound(arr) To i - 1
            If arr(j, 2) > arr(j + 1, 2) Then
                tempVal = arr(j, 2)
                arr(j, 2) = arr(j + 1, 2)
                arr(j + 1, 2) = tempVal
                tempVal = arr(j, 1)
                arr(j, 1) = arr(j + 1, 1)
                arr(j + 1, 1) = tempVal
            End If
        Next
    Next
    
    '工作表名升序排列
    For i = intSheetCount To 1 Step -1
        Worksheets(arr(i, 1)).Move before:=Worksheets(1)
    Next i
    
'    '工作表名降序排列
'    For i = 1 To intSheetCount
'        Worksheets(arr(i, 1)).Move before:=Worksheets(1)
'    Next i
End Sub

Function GetNumber(Str As String)
    '提取字符串中的数字
    Dim s As String, t As String
    Dim i As Long
    s = ""
    For i = 1 To Len(Str)
        t = Mid(Str, i, 1)
        If IsNumeric(t) = True Then
            s = s & t
        End If
    Next i
    GetNumber = s
End Function