How do i also hyperlink the create sheet in my below vba?-CodePudding

I've assigned a macro to a cell so when it is clicked it makes a copy of a template sheet, asks what name you want for it, and then adds that name to the next blank cell in a column.

I've had a go at doing it below, it doesn't error, however it also doesn't hyperlink either.

How do i now also make the cell where the name goes hyperlink to that sheet? Full vba on main sheet:

Public Sub CopySheetAndRenameByCell()
  Dim newName As String
  Dim Emrange As Range
  Set Emrange = Application.Range("C" & Rows.Count).End(xlUp).Offset(1)
  On Error Resume Next
  newName = InputBox("Enter the name of the new project", "Copy worksheet", ActiveCell.Value)

  If newName <> "" Then
    Sheets("Project Sheet BLANK").Copy After:=Worksheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = newName
    Emrange.Value = newName
    Worksheets(newName).Select
    Emrange.Select
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="newName!A1", TextToDisplay:="New sheet"
  End If
End Sub

CodePudding user response：

Like this:

Public Sub CopySheetAndRenameByCell()
    Dim newName As String, Emrange As Range, wsNew As Worksheet, wb As Workbook
    Dim wsIndex As Worksheet
    
    newName = InputBox("Enter the name of the new project", _
                       "Copy worksheet", ActiveCell.Value)
    
    If newName <> "" Then
        Set wb = ThisWorkbook
        wb.Worksheets("Project Sheet BLANK").Copy _
                      After:=wb.Worksheets(wb.Worksheets.Count)
        Set wsNew = wb.Worksheets(wb.Worksheets.Count)
        On Error Resume Next 'ignore error on rename
        wsNew.Name = newName
        On Error GoTo 0     'stop ignoring errors
        
        Set wsIndex = wb.Worksheets("Index") 'for example
        Set Emrange = wsIndex.Range("C" & Rows.Count).End(xlUp).Offset(1)
        wsIndex.Hyperlinks.Add Anchor:=Emrange, _
                           Address:="", SubAddress:="'" & wsNew.Name & "'!A1", _
                           TextToDisplay:=wsNew.Name
        'reset font style
        Emrange.Font.Underline = xlUnderlineStyleNone 
        Emrange.Font.ColorIndex = xlAutomatic

        If wsNew.Name <> newName Then 'in case sheet could not be renamed....
            MsgBox "Name provided '" & newName & _
                    "' is not valid as a worksheet name!", vbExclamation
        End If
    End If
End Sub