Excel VBA如何为活动单元格添加指向新建工作簿的超链接

你遇到的核心问题是超链接Address参数仅填写了文件夹路径，未拼接完整的新工作簿存储路径，同时原代码存在大量冗余的Select/Activate操作、硬编码工作簿名称的问题，极易引发运行报错。

修复后完整代码 #

Sub NewSheet()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim FName As String
    Dim savePath As String
    Dim fullSavePath As String
    
    ' 提前绑定所有对象，避免后续硬编码报错
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Sheet1")
    Set ws2 = wb1.Sheets("Sheet2")
    
    ' 直接读取C列最后一行作为文件名，无需复制粘贴
    FName = ws2.Range("C" & ws2.Cells.Rows.Count).End(xlUp).Value
    ws1.Range("H5").Value = FName
    
    ' 校验存储路径是否存在，不存在则自动创建
    savePath = "C:\Excel Testing\"
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If
    ' 拼接完整存储路径，FileFormat=52对应xlsm格式，后缀需匹配
    fullSavePath = savePath & FName & ".xlsm"
    
    ' 复制Sheet1生成新工作簿
    ws1.Copy
    Set wb2 = ActiveWorkbook
    
    ' 保存新工作簿
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=fullSavePath, FileFormat:=52
    Application.DisplayAlerts = True
    wb2.Close SaveChanges:=False ' 不需要保留新工作簿打开状态可保留此行，否则删除
    
    ' 添加超链接
    Dim linkCell As Range
    Set linkCell = ws2.Range("C" & ws2.Cells.Rows.Count).End(xlUp)
    ws2.Hyperlinks.Add _
        Anchor:=linkCell, _
        Address:=fullSavePath, _
        SubAddress:="Sheet1!A1", _
        TextToDisplay:=FName
End Sub

关键修改说明 #

• 移除所有无意义的Select/Activate操作，直接通过对象引用操作单元格和工作表，大幅降低报错概率
• 超链接Address参数填入完整的新工作簿存储路径，SubAddress指定跳转的目标工作表和单元格，点击后可直接定位到对应位置
• 新增路径自动创建逻辑，避免存储文件夹不存在导致的保存失败
• 移除硬编码的主工作簿名称引用，全部用变量操作，主工作簿重命名后代码仍可正常运行

适配调整提示 #

• 如果不需要保存为启用宏的工作簿，将FileFormat:=52改为FileFormat:=51，同时将路径拼接的后缀改为.xlsx即可
• 如果需要超链接跳转到新工作簿的其他位置，修改SubAddress参数即可，格式为目标工作表名!单元格地址

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