Sub CreateTableOfContents()
Dim ws As Worksheet
Dim tocSheet As Worksheet
Dim rowNum As Integer
Dim sheetNum As Integer
' 新しいシートを作成して目次を作成
Set tocSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
tocSheet.Name = "目次"
tocSheet.Range("B1").Value = "目次"
rowNum = 2
sheetNum = 1
' 各シートについてループ処理
For Each ws In ThisWorkbook.Sheets
' 目次に追加しないシートをスキップ
If ws.Name <> tocSheet.Name Then
' シートへのリンクを追加
tocSheet.Hyperlinks.Add Anchor:=tocSheet.Cells(rowNum, 2), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
' 番号を振る
tocSheet.Cells(rowNum, 1).Value = sheetNum & "."
rowNum = rowNum + 1
sheetNum = sheetNum + 1
End If
Next ws
' 目次シートの装飾
With tocSheet.Range("A2:A" & rowNum - 1)
.Font.Bold = True
.Columns(1).AutoFit
End With
End Sub