EXCELのシートを目次順に並べる

Public Sub 目次頁にいたら順にシートを並べる()
    Const LIST_SHEET_NAME = "目次"  'シート一覧の物理的なシート名

    '目次にいななら処理中断
    If ActiveSheet.Name <> LIST_SHEET_NAME Then
        MsgBox "シート並べ替えは目次ページで実行してください"
        Exit Sub
    End If
    Dim ListSheet
    Set ListSheet = ActiveSheet
    '
    '目次を最後に
    Worksheets(LIST_SHEET_NAME).Move After:=Worksheets(Worksheets.Count)

    Dim i As Long
    For i = 1 To Worksheets.Count
        If Trim(ListSheet.Cells(i, 2).Value) = "" Then
            Exit For
        End If
        Worksheets(ListSheet.Cells(i, 2).Value).Move After:=Worksheets(Worksheets.Count)
    Next i
    Worksheets(LIST_SHEET_NAME).Select
    MsgBox "シートの並べ替えが終わりました。"
End Sub

Public Sub シート一覧作成()
    Const LIST_SHEET_NAME = "目次"
    Const LIST_NO_COLIDX = 1
    Const LIST_NAME_COLIDX = 2
    Dim intIdx As Integer
    Dim intWksCnt As Integer
    Dim objWks As Object
    Dim strWks() As String
    Dim intLstShtIdx As Integer
    Dim intLstIdx As Integer
    Dim strSubAdr As String
    intLstShtIdx = -1
    intWksCnt = Excel.ActiveWorkbook.Worksheets.Count
    ReDim strWks(intWksCnt)
    For intIdx = 1 To intWksCnt
        strWks(intIdx) = Worksheets(intIdx).Name
        If strWks(intIdx) = LIST_SHEET_NAME Then
            intLstShtIdx = intIdx
        End If
    Next
    If intLstShtIdx < 0 Then
        Set objWks = ActiveWorkbook.Worksheets.Add(Before:=Worksheets(1))
        objWks.Name = LIST_SHEET_NAME
    Else
        Set objWks = Worksheets(LIST_SHEET_NAME)
    End If
    objWks.Select
    Range("A1:B999").ClearContents
    intLstIdx = 0
    For intIdx = 1 To intWksCnt
        If intLstShtIdx <> intIdx Then
            intLstIdx = intLstIdx + 1
            Cells(intLstIdx, LIST_NO_COLIDX) = intLstIdx
            Cells(intLstIdx, LIST_NAME_COLIDX) = "
            strSubAdr = "
            ActiveSheet.Hyperlinks.Add _
                Anchor:=Cells(intLstIdx, LIST_NAME_COLIDX), _
                Address:="", SubAddress:=strSubAdr, TextToDisplay:=strWks(intIdx)
        End If
    Next
End Sub