如何用VBA将已关闭Excel工作簿单列数据复制到当前工作簿并解决越界错误

错误原因排查 #

你原来的代码触发下标越界主要是这几个问题：

• currentbook 变量全程没有赋值，你试图调用Workbooks(currentbook)的时候，VBA找不到对应的工作簿对象，直接报错
• 取首个空列的逻辑有瑕疵：如果Data工作表完全空白，UsedRange.Columns.Count会返回1，会导致第一列就被覆盖
• 列号不能直接丢进Range()里当参数，Range()接受的是"A1"这种字符串引用，你直接传数字会被识别成行号，逻辑完全错误
• 打开了外部工作簿之后没有关闭，会残留后台进程

修复后可直接运行的代码 #

Sub 复制关闭工作簿数据()
    Dim fileName As Variant
    Dim newWorkbook As Workbook
    Dim targetSheet As Worksheet
    Dim freeColumn As Integer
    Dim sourceLastRow As Long
    
    ' 选择要导入的文件，点取消直接退出
    fileName = Application.GetOpenFilename("Excel文件 (*.xls*), *.xls*", , "选择要导入的工作簿")
    If fileName = False Then Exit Sub
    
    ' 绑定当前工作簿的Data表，不用Activate/Select，更稳定
    Set targetSheet = ThisWorkbook.Worksheets("Data")
    ' 计算首个空列，兼容空白表的情况
    If targetSheet.UsedRange Is Nothing Then
        freeColumn = 1
    Else
        freeColumn = targetSheet.UsedRange.Column + targetSheet.UsedRange.Columns.Count
    End If
    
    ' 只读打开源文件，不显示弹窗
    Set newWorkbook = Workbooks.Open(fileName, ReadOnly:=True, UpdateLinks:=False)
    ' 取源表A列最后一行有数据的行号，避免复制整列空值
    sourceLastRow = newWorkbook.Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 直接赋值比Copy粘贴效率高，不会动剪贴板
    targetSheet.Range(targetSheet.Cells(1, freeColumn), targetSheet.Cells(sourceLastRow, freeColumn)).Value = _
        newWorkbook.Worksheets(1).Range("A1:A" & sourceLastRow).Value
    
    ' 关闭源文件，不保存
    newWorkbook.Close SaveChanges:=False
    ' 释放对象
    Set newWorkbook = Nothing
    Set targetSheet = Nothing
    
    MsgBox "数据导入完成！", vbInformation
End Sub

代码说明 #

• 全程不用Activate、Select操作，避免窗口切换带来的不稳定问题
• 加了文件选择取消的判断，点取消不会报错
• 兼容Data工作表完全空白的场景，不会漏写第一列
• 只复制源表A列有数据的行，不会复制整列空白单元格，运行效率更高
• 打开文件时禁用链接更新，避免弹出额外的提示窗口
• 用完就关闭源文件、释放对象，不会残留Excel后台进程

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