目次作成マクロ

Sub makeSheetsContent()
'シート目次を作る
Dim arr As Variant
Dim ws As Worksheet
Dim rng As Range
Dim buf As String
Dim i As Integer
Dim wsNum As Integer

Call appSet
wsNum = Worksheets.Count 'シートの数。見出しも作成するために1加えておく

ReDim arr(1 To wsNum, 1 To 2)
'まず見出しをセット
For i = 1 To wsNum
arr(i, 1) = i '番号
arr(i, 2) = Worksheets(i).Name 'シート名
Next i

Worksheets.Add before:=Worksheets(1) 'シート名一覧のシート
Set ws = ActiveSheet

ws.Cells(1, 1).Value = "№"
ws.Cells(1, 2).Value = "シート名"
ws.Cells(2, 1).Resize(wsNum, 2).Value = arr

For i = 1 To wsNum
Set rng = ws.Cells(i + 1, 2) 'シート名を書いたセル
buf = arr(i, 2) 'シート名
ws.Hyperlinks.Add Anchor:=rng, Address:="", _
SubAddress:="'" & buf & "'" & "!$A$1", TextToDisplay:=buf 'リンクも追加
Next i

Rows(1).HorizontalAlignment = xlCenter '横方向は中央揃え
Cells(1, 1).Resize(1, 2).EntireColumn.AutoFit '列幅の自動調整

Call appReset
End Sub

Sub appSet()
'マクロ処理中に、描画など余計なものを省略して高速化
With Application
.ScreenUpdating = False '描画を省略
.Calculation = xlCalculationManual '手動計算
.DisplayAlerts = False '警告を省略。
' .EnableEvents = False 'DisplayAlertsよりこちらを設定した方が良いのかな？
End With
End Sub

Sub appReset()
'描画などの設定をリセット
With Application
.ScreenUpdating = True '描画する
.Calculation = xlCalculationAutomatic '自動計算
.DisplayAlerts = True '警告を行う
End With
End Sub