Inhaltsverzeichnis der Arbeitsblätter erstellen

Sub InhaltsverzeichnisErstellen()
    Dim ws As Worksheet, toc As Worksheet, r As Long
    On Error Resume Next
    Set toc = ThisWorkbook.Worksheets("Inhaltsverzeichnis")
    On Error GoTo 0
    If toc Is Nothing Then
        Set toc = Worksheets.Add(Before:=Worksheets(1))
        toc.Name = "Inhaltsverzeichnis"
    Else
        toc.Cells.Clear
    End If
    toc.Range("A1").Value = "Arbeitsblätter"
    r = 2
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible And ws.Name <> toc.Name Then
            toc.Hyperlinks.Add Anchor:=toc.Cells(r, 1), Address:="", SubAddress:="'" & ws.Name & "'!A1", TextToDisplay:=ws.Name
            r = r + 1
        End If
    Next ws
    toc.Columns.AutoFit
End Sub