就像这样：

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