Generate a hyperlinked table of contents linking to each sheet in an Excel workbook (blog post: http://blog.richpollock.com/2014/11/generating-a-hyperlinked-table-of-contents-for-an-excel-workbook-using-vba/)

gistfile1.vb

Sub GenerateLinkedTOCFromWorkSheetNames()

    Dim ProposedTOCWorksheetName As String
    Dim NewTOCWorksheetName As String
    Dim CurrentWorksheet As Worksheet
    Dim Count As Integer
    
    ProposedTOCWorksheetName = "TOC"
    NewTOCWorksheetName = "TOC"
    RowCounter = 2

    Application.ScreenUpdating = False

    Do While SheetExists(NewTOCWorksheetName)
        NewTOCWorksheetName = Application.InputBox( _
            Prompt:="A sheet named '" & ProposedTOCWorksheetName & "' already exists. " & _
                "Enter a new sheet name or type '" & ProposedTOCWorksheetName & "' to overwrite.", _
            Type:=2)
        
        If NewTOCWorksheetName = ProposedTOCWorksheetName Then
            Exit Do
        End If
        
        ProposedTOCWorksheetName = NewTOCWorksheetName
    Loop
    
    If SheetExists(NewTOCWorksheetName) Then
        Sheets(NewTOCWorksheetName).Cells.Clear
    Else
        Sheets.Add Before:=Worksheets(1)
        Worksheets(1).Name = NewTOCWorksheetName
    End If

    For Each CurrentWorksheet In Worksheets
        If CurrentWorksheet.Name <> NewTOCWorksheetName Then
            Sheets(NewTOCWorksheetName).Range("B" & RowCounter).Value = CurrentWorksheet.Name
        
            Sheets(NewTOCWorksheetName).Hyperlinks.Add _
                Anchor:=Sheets(NewTOCWorksheetName).Range("B" & RowCounter), _
                Address:="", _
                SubAddress:="'" & CurrentWorksheet.Name & "'!A1", _
                TextToDisplay:=CurrentWorksheet.Name, _
                ScreenTip:=CurrentWorksheet.Name
        
            RowCounter = RowCounter + 1
        End If
    Next
    
    Application.ScreenUpdating = True

End Sub

Function SheetExists(SheetName As String) As Boolean
    
    Dim TestWorksheet As Worksheet
    SheetExists = False
    
    On Error Resume Next
    Set TestWorksheet = Sheets(SheetName)
    If Not TestWorksheet Is Nothing Then SheetExists = True
    Set TestWorksheet = Nothing
    On Error GoTo 0
    
End Function