シート名を変えるたびに目次を修正するのが面倒だったので

機能

1. 「目次」シートを一番左に移動する。
2. 既存の目次をクリアする。
3. ブック内のシート名を取得し、「目次」シートに一覧化する。
4. 各シートへのリンク（HYPERLINK関数）をシート名分コピーする。
5. 「表示状態」列に表示・非表示を記載（非表示の場合は行単位でグレーアウト）（2022/5/8追加）
6. オートフィルタ設定（2022/5/8追加）

シート建付け

• シート名
  目次
• 構成
  ※ 目次の開始行、開始列は定数で指定。
  

ソースコード

Module1

'＜ 共通設定 ＞
'シート名
Public Const SHEET_NAME_INDEX = "目次"


'***** 目次更新 *****
Sub UpdateIndex()
    
    '行数
    Const INDEX_START_ROW = 2
    '列数
    Const NO_COL = 1
    Const SHEET_NAME_COL = 2
    Const LINK_COL = 3
    Const VISIBLE_STATUS_COL = 4
    '関数
    Const LINK_FORMURA = _
        "=IF(B2<>"""",HYPERLINK(""#'"" & B2 & ""'!A1"", ""→ "" & B2), """")"
    '文言
    Const STATUS_VISIBLE = "表示"
    Const STATUS_INVISIBLE = "非表示"
    '終了メッセージ
    Const END_MESSAGE = "更新完了"
    
    'No 初期化
    Dim cntNo As Long
    cntNo = 1
    '編集行 初期化
    Dim workRow As Long
    workRow = INDEX_START_ROW
    
    
    '処理前アクション
    StartAction SHEET_NAME_INDEX
    
    
    'シート表示状況 取得
    Dim visibleFlagDic As Object
    Set visibleFlagDic = SetVisibleFlagDic


    '全シート 表示
    AllSheetsVisible
    
    
    '「目次」を先頭に移動
    Sheets(SHEET_NAME_INDEX).Move before:=Sheets(1)
    
    
    'シート数 取得
    Dim ThisBookName As String
    ThisBookName = ThisWorkbook.Name
    Dim sheetCount As Long
    sheetCount = GetSheetCount(ThisBookName)
    
    
    '既存データ 削除
    Dim maxRow As Long
    maxRow = GetMaxRow(SHEET_NAME_INDEX, NO_COL)
    CellClear _
        SHEET_NAME_INDEX, _
        INDEX_START_ROW, _
        maxRow, _
        NO_COL, _
        VISIBLE_STATUS_COL


    '2行目 初期化
    With Cells(INDEX_START_ROW, NO_COL)
        'No
        .Value = cntNo
        'シート名
        .Offset(0, 1).Value = SHEET_NAME_INDEX
        'リンク
        .Offset(0, 2).Formula = LINK_FORMURA
        '表示状態
        If visibleFlagDic.Item(SHEET_NAME_INDEX) = True Then
            .Offset(0, 3).Value = STATUS_VISIBLE
        Else
            .Offset(0, 3).Value = STATUS_INVISIBLE
        End If
        .Offset(0, 3).HorizontalAlignment = xlCenter
    End With
    
    
    'シート名 記入
    Dim i As Long
    
    For i = 1 To sheetCount
        '3行目以降に対する処理
        If workRow > INDEX_START_ROW Then
            'No挿入
            Cells(workRow, NO_COL).Value = cntNo
            'シート名
            Cells(workRow, SHEET_NAME_COL).Value = Sheets(i).Name
            'リンク表示関数
            FormulaCopyDown workRow, LINK_COL
            '表示状態
            With Cells(workRow, VISIBLE_STATUS_COL)
                If visibleFlagDic.Item(Sheets(i).Name) = True Then
                    .Value = STATUS_VISIBLE
                Else
                    .Value = STATUS_INVISIBLE
                    Range(.Offset(0, -3), .Offset(0, 0)).Interior.ColorIndex = WEAK_GRAY
                End If
                .HorizontalAlignment = xlCenter
            End With
        End If

        'No 更新
        cntNo = cntNo + 1
        '次の行へ
        workRow = workRow + 1
    
    Next i
    
    
    'オートフィルタ
    Selection.CurrentRegion.AutoFilter
         
         
    '（非表示だったシートのみ）再非表示
    Dim tmpVisFlag As Boolean
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        tmpVisFlag = visibleFlagDic.Item(ws.Name)
        
        If tmpVisFlag = False Then
            ws.Visible = tmpVisFlag
        End If
    
    Next
    
         
    '列幅自動調整
    ColAutoFit NO_COL, LINK_COL
    
    
    '表示倍率：100％
    ZoomSet 100
    
    
    '処理後アクション
    EndAction SHEET_NAME_INDEX, END_MESSAGE


End Sub

Module2

Option Explicit

'■ ■ ■　よく使う処理　■ ■ ■

'***** 処理前アクション *****
'機能：処理開始前にExcelの描画を止める（任意）
Sub StartAction(ByVal sheetName As String, Optional ByVal ScreenUpdateFlag As Boolean = True)

    ThisWorkbook.Activate
    
    '描画停止
    If ScreenUpdateFlag = False Then
        Application.ScreenUpdating = ScreenUpdateFlag
    End If
    
    '対象シート 有効化
    Worksheets(sheetName).Activate

End Sub


'***** 処理後アクション *****
'機能：① Excelの描画を再開させる。
'　　：② [Ctrl + HOME] を押下した位置にカーソルを移動させる。
'　　：③ 終了メッセージを表示させる。
Sub EndAction(ByVal sheetName As String, ByVal endMessage As String)

    ThisWorkbook.Activate
    
    '描画再開
    Application.ScreenUpdating = True
    
    '対象シート 有効化
    Sheets(sheetName).Activate
    
    'Ctrl + HOMEの位置にカーソル移動
    With ActiveWindow
        ActiveWindow.ActiveSheet.Cells(.SplitRow + 1, .SplitColumn + 1).Activate
    End With
    
    '終了メッセージ 表示
    MsgBox endMessage

End Sub


'***** 表示倍率 変更 *****
'機能: 指定した表示倍率に変更する｡
Sub ZoomSet(ByVal zoomPercentage As Long)

    '表示倍率 変更
    ActiveWindow.ZOOM = zoomPercentage

End Sub


'***** 最大行 取得 *****
'機能：最大行を取得する。
Function GetMaxRow(ByVal targetSheetName As String, ByVal targetCol As Long) As Long

    GetMaxRow = Sheets(targetSheetName).Cells(Rows.Count, targetCol).End(xlUp).Row

End Function


'***** シート数 取得 *****
'機能：対象ブックのシート数を取得する。
Function GetSheetCount(ByVal targetBookName As String) As Long

    GetSheetCount = Workbooks(targetBookName).Sheets.Count

End Function


'***** 数式コピー（Ctrl + D） *****
'機能：一行上の数式をコピーする。
Sub FormulaCopyDown(ByVal targetRow As Long, ByVal targetCol As Long)

    Cells(targetRow - 1, targetCol).Copy
    Cells(targetRow, targetCol).PasteSpecial Paste:=xlPasteFormulas

End Sub


'***** 列幅 自動調整 *****
'機能：対象列（複数でも可）の幅を自動調整する。
Sub ColAutoFit(ByVal startCol As Long, ByVal endCol As Long)

    Range(Columns(startCol), Columns(endCol)).AutoFit

End Sub


'***** シート表示状態 取得 *****
'機能：全シートの表示 / 非表示を連想配列に記録して返す。
Function SetVisibleFlagDic() As Object
    
    Dim tmpDic As Object
    Set tmpDic = CreateObject("Scripting.Dictionary")
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        tmpDic.Add ws.Name, ws.Visible
    Next
    
    Set SetVisibleFlagDic = tmpDic

End Function


'***** 全シート表示 *****
'機能：全シートの表示させる。
Sub AllSheetsVisible(Optional ByVal bookName As String = "")
    
    Dim ws As Worksheet
    
    If bookName <> "" Then
        Workbooks(bookName).Activate
    Else
        ThisWorkbook.Activate
    End If
    
    For Each ws In Worksheets
        ws.Visible = True
    Next
    
End Sub


'***** 対象範囲 クリア *****
'機能：対象範囲のデータや書式を削除
Sub CellClear(ByVal sheetName As String, ByVal startRow As Long, ByVal endRow As Long, ByVal startCol As Long, ByVal endCol As Long)

    Sheets(sheetName).Range( _
        Cells(startRow, startCol), Cells(endRow, endCol) _
    ).Clear

End Sub

ソースコードの全量は こちら