Excel VBA实操：为工作簿内新建工作表添加对应单元格Hyperlink

修改后可实现超链接关联的完整VBA代码 #

Sub New_sheet()
    Dim ShtName As String
    Dim sourceCell As Range
    Application.DisplayAlerts = False
    On Error GoTo ErrMsg
    ' 提前记录触发代码时的选中单元格，避免工作表切换后定位丢失
    Set sourceCell = ActiveCell
    ShtName = sourceCell.Value2 ' 保存选中单元格的值作为新工作表名
    Set ws = Sheets("Blank incident tab")
    ws.Copy After:=Sheets("Incident Catagories")
    Set wsNew = Sheets(Sheets("Incident Catagories").Index + 1)
    wsNew.Name = ShtName
    ' 给原选中单元格添加超链接，跳转至新建工作表的A1单元格
    ActiveSheet.Hyperlinks.Add _
        Anchor:=sourceCell, _
        Address:="", _
        SubAddress:="'" & ShtName & "'!A1", _
        TextToDisplay:=CStr(sourceCell.Value2)
    ' 正常执行结束后恢复系统告警提示，修复原有代码的逻辑遗漏
    Application.DisplayAlerts = True
    Exit Sub

ErrMsg:
    MsgBox "该事件报告已存在，请检查后新建其他事件", , "重复事件错误"
    Sheets("Blank incident tab (2)").Delete
    Application.DisplayAlerts = True
End Sub

核心修改说明 #

• 新增sourceCell变量提前存储触发代码时的激活单元格，避免复制工作表后活动页切换，导致超链接加错位置
• 新增的超链接逻辑用单引号包裹工作表名，兼容带空格、特殊字符的工作表名场景，跳转目标可根据需求调整为其他单元格
• 修复了原有代码正常执行路径下未恢复Application.DisplayAlerts = True的问题，避免后续Excel操作无告警提示的异常
• 优化了错误提示的中文表述，修正了原版英文提示的拼写错误

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