如何在现有VBA宏中为新建工作表添加单元格超链接？

原代码的超链接未生效，核心问题是超链接的子地址（SubAddress）使用了字符串字面量"newName!A1"，没有引用实际的工作表名称变量，同时冗余的Select操作也可能导致逻辑混乱。以下是修正后的代码：

Public Sub CopySheetAndRenameByCell()
    Dim newName As String
    Dim Emrange As Range
    Dim newSheet As Worksheet
    
    ' 定位C列首个空白单元格
    Set Emrange = ThisWorkbook.Range("C" & Rows.Count).End(xlUp).Offset(1)
    
    ' 获取用户输入的工作表名称
    newName = InputBox("Enter the name of the new project", "Copy worksheet", ActiveCell.Value)
    
    ' 验证输入不为空
    If newName <> "" Then
        ' 复制模板工作表并保存引用
        Sheets("Project Sheet BLANK").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        Set newSheet = ActiveSheet
        
        ' 重命名新工作表（处理命名冲突）
        On Error Resume Next
        newSheet.Name = newName
        If Err.Number <> 0 Then
            MsgBox "工作表名称无效或已存在，请重新输入。", vbExclamation
            newSheet.Delete
            Exit Sub
        End If
        On Error GoTo 0
        
        ' 写入名称并添加超链接
        With Emrange
            .Value = newName
            .Hyperlinks.Add Anchor:=.Cells(1), _
                           Address:="", _
                           SubAddress:="'" & newName & "'!A1", _
                           TextToDisplay:=newName
        End With
    End If
End Sub

关键修改点： #

• 超链接子地址修正：将SubAddress:="newName!A1"改为SubAddress:="'" & newName & "'!A1"，用变量拼接生成实际的工作表地址，单引号确保带空格的工作表名称能被正确识别。
• 避免冗余的Select操作：直接通过Emrange对象进行赋值和添加超链接，无需激活单元格，提升代码稳定性和效率。
• 错误处理优化：仅在重命名工作表时启用错误捕获，若命名失败则提示用户并删除新建的空白工作表，避免遗留无效工作表。
• 明确工作簿引用：使用ThisWorkbook限定操作范围，防止在多个工作簿打开时出现逻辑错误。

内容的提问来源于stack exchange，提问作者Steve101