List Sheetnames as Hyperlinks

Question

Hi All........

Some kind person gave me this macro some time back, sorry I don't remember who.

Sub ListSheets()
'Lists all SheetNames in Workbook on new sheet called "SheetNames"
On Error Resume Next
Sheets.Add.Name = ("SheetNames")
For i = 1 To Worksheets.Count
Cells(i, "a") = Sheets(i).Name
Next i
End Sub

It works beautifully as far as it goes. 

Now, I need those Sheetnames in the list made into Hyperlinks to each of their sheets in the current workbook, and not be linked to the workbook name because that will change with time.

I know how to do it by hand, but that takes a long time.  I would much appreciate it if someone could give me the code to do it automatically.  I've tinkered with it but no joy yet.

Any help would be much appreciated.

Vaya con Dios,

Chuck, CABGx3

---

Chuck, CABGx3

Answer 1

Try this version:

Sub ListSheets()
    Dim wsh As Worksheet
    Dim i As Long
    Dim strName As String
    On Error Resume Next
    Set wsh = Worksheets("SheetNames")
    On Error GoTo 0
    If wsh Is Nothing Then
        Set wsh = Worksheets.Add(Before:=Worksheets(1))
        wsh.Name = "SheetNames"
    Else
        wsh.Range("A:A").Delete
    End If
    For i = 2 To Worksheets.Count
        strName = Worksheets(i).Name
        wsh.Hyperlinks.Add Anchor:=wsh.Cells(i - 1, 1), _
            Address:="", _
            SubAddress:="'" & strName & "'!A1", _
            TextToDisplay:=strName
    Next i
End Sub

---

Regards, Hans Vogelaar

Answer 2

Geez Hanz, that's only BRILLIANT!!!

Many thanks, your version works perfectly for me.

Vaya con Dios,

Chuck, CABGx3

---

Chuck, CABGx3