none
List Sheetnames as Hyperlinks RRS feed

  • 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

    Wednesday, December 26, 2012 12:57 AM

Answers

  • 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

    • Marked as answer by CABGx3 Wednesday, December 26, 2012 1:13 AM
    Wednesday, December 26, 2012 1:10 AM

All replies

  • 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

    • Marked as answer by CABGx3 Wednesday, December 26, 2012 1:13 AM
    Wednesday, December 26, 2012 1:10 AM
  • Geez Hanz, that's only BRILLIANT!!!

    Many thanks, your version works perfectly for me.

    Vaya con Dios,

    Chuck, CABGx3


    Chuck, CABGx3

    Wednesday, December 26, 2012 1:35 AM