How put a hyperlink on table of contents page using VBA code?

[ChetShannon]

Help-
Need help please adding hyperlinks to each sheet in my workbook. I have a "cover sheet" sheet which has a table of contents and each line item is simply all the sheet names in the workbook and the sheet name is a link to the individual sheets.

I'm trying to make it easy for the end-user to jump from the cover sheet to the particular sheet inside the workbook they are going to. I've been trying to set up some code to do this but it is crashing on the hyperlink add line. "cover sheet" is the page the table of contents is on. The output would be every sheet name as a hyperlink starting in row 26 going down the sheet.

Thanks for your help!

Sub MAKE_LINKED_TBL_OF_CONTENTS()
'CLEAR OUT OLD CONTENTS PAGE
Sheets("cover sheet").Select
Range("A26:A99").Select
Selection.ClearContents


'CYCLE THROUGH GET SHEET NAMES ADD TO COVER SHEET
Dim X As Worksheet

For Each X In Worksheets

X.Activate
If X.Name = "cover sheet" Then GoTo NextSheet

'GOTO COVER SHEET PASTE IN HERE
Sheets("cover sheet").Select
MaxRowNow = Cells(65525, 1).End(xlUp).Row
Cells(MaxRowNow + 1, 1) = X.Name

'BACK TO SHEET WAS ON BEFORE
Sheets(X.Name).Activate

NextSheet:
Next X

'***********************************
'THIS PART IS NOT WORKING RIGHT YET!
'**** AS OF 9/25/2017 **************
'***********************************
'ADD LINKS TO EACH ENTRY OF THE NEW TOC
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim wsActive As Worksheet
Set wsSheet = ActiveSheet
Sheets("cover sheet").Select
MaxRowNow = Cells(65525, 1).End(xlUp).Row
For RowY = 26 To MaxRowNow
Cells(RowY, 1).Select
SheetName = Cells(RowY, 1)
Set wsActive = wbBook.ActiveSheet
With wsActive
.Hyperlinks.Add .Cells(RowY, 1), "", _
SubAddress:="'" & wsSheet.Name & "'!A1", _
TextToDisplay:=wsSheet.Name
End With

Next RowY
End Sub

 

[My Aswer Is This]

Try this:

This script will put all the sheet names in Column (A) of sheet named "cover sheet" and a link to all the sheets
This script will also put a link in Range("A1") of all sheets to take you back to the sheet named "cover sheet"

Please be sure "cover sheet" is the exact name for your cover sheet otherwise modify the script where marked in red.

Sub AddHyperLinks()
'Modified 9-27-17 1:10 AM EDT
Dim C As Range
Dim i As Long
Dim ans As String
ans = "[COLOR=#ff0000]cover sheet[/COLOR]"
Sheets(ans).Columns(1).Clear
    For i = 1 To Sheets.Count
    If Sheets(i).Name <> ans Then
    Sheets(ans).Cells(i, 1).Value = Sheets(i).Name
    Sheets(i).Cells(1, 1).Value = Sheets(ans).Name
    Sheets(i).Cells(1, 1).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, 1), Address:="", SubAddress:="'" & Sheets(i).Cells(1, 1).Value & "'!A1"
    End If
    Next

With Sheets(ans)
    For Each C In .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        .Hyperlinks.Add Anchor:=C, Address:="", SubAddress:="'" & C.Value & "'!A1"
    Next C
End With
End Sub

 

[My Aswer Is This]

Sorry forgot you want sheet names to start on row 26

Try this:

Sub AddHyperLinks()
'Modified 9-27-17 1:40 AM EDT
Dim C As Range
Dim i As Long
Dim x As Long
x = 26
Dim ans As String
ans = "[COLOR=#ff0000]cover sheet[/COLOR]"
Sheets(ans).Range("A26:A" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
    For i = 1 To Sheets.Count
    If Sheets(i).Name <> ans Then
    Sheets(ans).Cells(x, 1).Value = Sheets(i).Name
    Sheets(i).Cells(1, 1).Value = Sheets(ans).Name
    Sheets(i).Cells(1, 1).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, 1), Address:="", SubAddress:="'" & Sheets(i).Cells(1, 1).Value & "'!A1"
    x = x + 1
    End If
    Next

With Sheets(ans)
    For Each C In .Range("A26:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        .Hyperlinks.Add Anchor:=C, Address:="", SubAddress:="'" & C.Value & "'!A1"
    Next C
End With
End Sub