Excel VBA需求：多工作表指定列数据合并复制到剪贴板

原代码的核心问题是直接用&拼接两个Range返回的二维数组无效，另外还有数组索引、命令行引号拼接、工作簿未关闭的问题，以下是修正后的完整代码：

Sub SaveInCb()
    Dim Txt As String
    Dim Wb02 As Workbook
    Dim tblData As Variant
    Dim i As Long
    
    ' 错误处理：防止文件路径错误或文件被占用
    On Error Resume Next
    Set Wb02 = Workbooks.Open("myExcelPath")
    On Error GoTo 0
    If Wb02 Is Nothing Then
        MsgBox "无法打开目标工作簿，请检查路径！"
        Exit Sub
    End If
    
    Txt = ""
    
    Select Case Application.Caller
        Case "BT01"
            tblData = Wb02.Range("Table1[columnB]").Value
            ' 遍历数组收集非空数据
            For i = LBound(tblData, 1) To UBound(tblData, 1)
                If Not IsEmpty(tblData(i, 1)) Then
                    Txt = Txt & tblData(i, 1) & ";"
                End If
            Next i
            
        Case "BT02"
            tblData = Wb02.Range("Table2[columnB]").Value
            For i = LBound(tblData, 1) To UBound(tblData, 1)
                If Not IsEmpty(tblData(i, 1)) Then
                    Txt = Txt & tblData(i, 1) & ";"
                End If
            Next i
            
        Case "BT01_BT02"
            ' 先处理Table1的数据
            tblData = Wb02.Range("Table1[columnB]").Value
            For i = LBound(tblData, 1) To UBound(tblData, 1)
                If Not IsEmpty(tblData(i, 1)) Then
                    Txt = Txt & tblData(i, 1) & ";"
                End If
            Next i
            ' 再处理Table2的数据
            tblData = Wb02.Range("Table2[columnB]").Value
            For i = LBound(tblData, 1) To UBound(tblData, 1)
                If Not IsEmpty(tblData(i, 1)) Then
                    Txt = Txt & tblData(i, 1) & ";"
                End If
            Next i
    End Select
    
    ' 去除末尾多余的分号
    If Len(Txt) > 0 Then
        Txt = Left(Txt, Len(Txt) - 1)
    End If
    
    ' 修正剪贴板命令的引号拼接
    If Txt <> "" Then
        Shell "cmd.exe /c echo """ & Txt & """|clip", vbHide
    End If
    
    ' 关闭目标工作簿，不保存修改
    Wb02.Close SaveChanges:=False
    Set Wb02 = Nothing
End Sub

关键修复点说明： #

• 数组合并逻辑：不再直接拼接数组，而是分别遍历两个表的数组，把非空值逐一追加到文本变量中
• 数组索引修正：用LBound和UBound动态获取数组边界，避免硬编码起始值导致的越界错误（Range返回的数组默认是1起始）
• 命令行语法修正：正确嵌套双引号，确保包含特殊字符的文本能正确复制到剪贴板
• 工作簿管理：添加错误处理判断工作簿是否打开成功，最后关闭工作簿并释放对象，避免文件锁定
• 分号处理：原代码Len(Txt)-2是错误的，分号占1个字符，改为Len(Txt)-1

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