Excel宏导入多Sheet后仅首个Hyperlink有效，其余失效且名称重复

原宏存在三个核心问题：

1. 超链接文本被覆盖：每次处理一个源文件时，都会遍历所有符合条件的工作表重新生成超链接，导致后续源文件的名称会覆盖之前所有超链接的显示文本。
2. 超链接位置重复覆盖：每次都从Hyperlink工作表的A1单元格开始创建，新的超链接会直接覆盖旧内容，无法按顺序排列。
3. 跳转地址格式错误：超链接的子地址添加了冗余引号，且未对含特殊字符的工作表名称做处理，导致部分跳转提示“引用无效”。

Sub ImportSheetsFromFolder()
    Dim folderPath As String
    Dim selectedFile As Variant
    Dim targetWorkbook As Workbook
    Dim sourceWorkbook As Workbook
    Dim sheetName As String
    Dim wsSource As Worksheet
    Dim wsHyperlink As Worksheet
    Dim lastRow As Long
    
    ' 选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含Excel文件的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "未选择文件夹，退出程序。"
            Exit Sub
        End If
    End With
    
    ' 设置目标工作簿与超链接工作表
    Set targetWorkbook = ThisWorkbook
    Set wsHyperlink = targetWorkbook.Worksheets("Hyperlink")
    
    ' 输入需要导入的工作表名称
    sheetName = InputBox("输入要导入的工作表名称：", "工作表名称")
    If sheetName = "" Then
        MsgBox "未提供工作表名称，退出程序。"
        Exit Sub
    End If
    
    ' 遍历文件夹中的所有xlsx文件
    selectedFile = Dir(folderPath & "\*.xlsx")
    Do While selectedFile <> ""
        ' 打开源工作簿
        Set sourceWorkbook = Workbooks.Open(folderPath & "\" & selectedFile)
        
        ' 检查源工作簿是否存在目标工作表
        On Error Resume Next
        Set wsSource = sourceWorkbook.Sheets(sheetName)
        On Error GoTo 0
        
        ' 若存在则导入并创建对应超链接
        If Not wsSource Is Nothing Then
            wsSource.Copy After:=targetWorkbook.Sheets(targetWorkbook.Sheets.Count)
            
            ' 获取超链接工作表的最后一行，避免覆盖旧内容
            lastRow = wsHyperlink.Cells(wsHyperlink.Rows.Count, "A").End(xlUp).Row
            If lastRow = 1 And wsHyperlink.Range("A1").Value = "" Then
                lastRow = 1
            Else
                lastRow = lastRow + 1
            End If
            
            ' 为刚导入的工作表创建超链接
            wsHyperlink.Hyperlinks.Add _
                Anchor:=wsHyperlink.Range("A" & lastRow), _
                Address:="", _
                SubAddress:="'" & targetWorkbook.Sheets(targetWorkbook.Sheets.Count).Name & "'!A1", _
                ScreenTip:="跳转至 " & targetWorkbook.Sheets(targetWorkbook.Sheets.Count).Name, _
                TextToDisplay:=sourceWorkbook.Name
        End If
        
        ' 关闭源工作簿（不保存）
        sourceWorkbook.Close False
        
        ' 处理下一个文件
        selectedFile = Dir
    Loop
   
    MsgBox "导入完成。"
End Sub

• 精准创建超链接：仅在成功导入单个工作表后，为该新工作表创建对应超链接，确保显示文本与源工作簿一一对应。
• 动态定位插入位置：通过lastRow获取超链接工作表的最后有效行，新超链接自动追加到下一行，避免覆盖旧内容。
• 修正跳转地址格式：为工作表名称添加单引号，兼容含空格或特殊字符的工作表名称，同时移除冗余引号，确保跳转有效。
• 取消冗余选择操作：直接引用工作表对象，避免使用Select和ActiveCell，提升代码稳定性与执行效率。

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