List of sheets with hyperlinks

I regularly create a list of sheets in a contents sheet in my files. I then create hyperlinks to the sheets. Can this process be automated?

By Neale Blackwood

The macro below will create a list of all sheets in the current workbook. This list will start at the active cell. A hyperlink to each sheet is then created. No chart sheets will be listed, only worksheets. The macro will stop if it encounters cells that have entries.

To insert this macro in the current worksheet, right click the sheet name and select View Code. Either type the macro EXACTLY as it appears below, or copy it from the CPA website. Once entered you can run the macro by selecting the cell you want the sheet list to start from and holding Alt and press F8. Ensure the “Macros in” box has “All Open Workbooks” selected. Select the SheetListHyperLink macro and click the Run button. The list should then appear.

Sub SheetListHyperLink()
‘This macro creats a list of sheet names and hyperlinks to those sheets
Dim c, d, rCell As Range
d = 0 ‘counter used to increment rows in offset command
For Each c In Sheets
Set rCell = ActiveCell.Offset(d, 0)
If rCell <> “” Then Exit Sub ‘stop the macro if the cell contains anything
If c.Type <> 3 Then ‘3 = Chart – only create entry if sheet is NOT a chart
rCell.Value = c.Name
rCell.Hyperlinks.Add Anchor:=rCell, Address:=””, SubAddress:= _
“‘” & c.Name & “‘!A1”, TextToDisplay:=c.Name
d = d + 1
End If
Next c
End Sub

Extras

The version below uses the Worksheets collection, which automatically ignores charts. After following a hyperlink pressing F5 followed by Enter will return you to where you were.

Sub SheetListHyperLinkv2()
‘This macro creates a list of sheet names and hyperlinks to those sheets
Dim c, d
Dim rCell As Range
d = 0 ‘counter used to increment rows in offset command
For Each c In Worksheets
Set rCell = ActiveCell.Offset(d, 0)
‘stop the macro is the cell contains anything
If rCell <> “” Then Exit Sub
rCell.Value = c.Name
rCell.Hyperlinks.Add Anchor:=rCell, _
Address:=””, SubAddress:=”” _
& “‘” & c.Name & “‘” & “!A1”, TextToDisplay:=c.Name
d = d + 1
Next c
End Sub