シートを移動するのがめんどくさいので、目次を作るマクロを作ってみた。
'ﾊｲﾊﾟｰﾘﾝｸ表紙作成------------------------------------------こんな感じのができます。
Sub CreateCoverPage()
'例外処理
On Error GoTo Exception
'Define
Dim objApp As Application
Dim objWB As Workbook
Dim objWS As Worksheet
Dim sCnt As Integer 'シート数
Dim sHyper() As String 'シート名ハイパーリンク文字列配列
Dim I As Integer 'ループ用
Dim rVis As range '非表示確認用
'Instance
Set objApp = Application
'表示の変更
objApp.DisplayAlerts = False
objApp.ScreenUpdating = False
objApp.Cursor = xlWait
'ﾌｧｲﾙｵｰﾌﾟﾝ
Set objWB = ActiveWorkbook
'ｼｰﾄ数ｹﾞｯﾄ
sCnt = objWB.Sheets.Count
'配列にハイパーリンクアドレスを作成
ReDim sHyper(sCnt - 1)
For I = 0 To sCnt - 1
sHyper(I) = objWB.Sheets(I + 1).name
Next
'表紙シート作成
Set objWS = objWB.Sheets.Add(Before:=objWB.Sheets(1))
On Error Resume Next 'シート名が重複しても処理を続ける
objWS.name = "目次"
On Error GoTo Exception
'既存シートのシート名をハイパーリンクとして表紙に記述
For I = 1 To sCnt
objWS.Cells(I + 3, 2).Select 'シート名記述はB4から下へ
objWS.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'" & sHyper(I - 1) & "'!A1", TextToDisplay:=sHyper(I - 1)
Next
With objWS 'シートタブの色
.Tab.ColorIndex = 50
'結合
.range("B1:C1").Merge
.range("D1:G1").Merge
'補足表示
.range("B1").Value = "ブック名 ： [" & objWB.name & "]"
.range("D1").Value = "目次作成日：" & CStr(Now)
.range("B3").Value = "シート名"
.range("C3").Value = "説明"
.range("D3").Value = "作成日"
.range("E3").Value = "作成者"
'太字・アライン
.range("B1:D1").Font.Bold = True
.range("B3:E3").Font.Bold = True
.range("B3:E3").HorizontalAlignment = xlCenter
'表示形式
.Columns("D:D").NumberFormatLocal = "yyyy/m/d"
'色をつける
.range("B1").Characters(Start:=7).Font.ColorIndex = 53
.range("B3:E3").Interior.ColorIndex = 40
.range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Interior.ColorIndex = 35
'カラムサイズを設定する
.Columns("A:A").ColumnWidth = 2
.Columns("B:B").EntireColumn.AutoFit
.Columns("C:C").ColumnWidth = 58.13
.Columns("D:D").ColumnWidth = 11.5
'罫線
With .range("B3:E3").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range("B3:E3").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range("B3:E3").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range("B3:E3").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range("B3:E3").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
If sCnt <> 1 Then
With .range(.Cells(4, 2), .Cells(3 + sCnt, 5)).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End With
Exit Sub
Exception: 'Dispose
Set objApp = Nothing
Set objWB = Nothing
Set objWS = Nothing
'削除確認ダイアログを出す
Application.DisplayAlerts = True
Application.Visible = True
Application.Cursor = xlDefault
MsgBox "エラーが発生しました" & vbCrLf & _
"エラー番号：" & Err.Number & " エラー詳細：" & Err.Description _
, vbExclamation, "システム"
End Sub
そして目次にジャンプするマクロ（これがないとあんまり意味ない）
また次回。
