Excel VBA跨工作簿复制单元格区域代码运行异常如何解决

问题根因 #

代码失效的核心问题集中在3点，和你怀疑的单元格选择逻辑直接相关：

• 所有依赖Select/Selection的操作都不生效：VBA中Range.Select方法仅能作用于当前处于激活状态的工作表，代码全程没有激活sht1、sht2，直接在非激活表上执行选中操作，要么直接抛出运行时错误，要么选中的是当前激活表的无关范围，这也是sht1.Range("A1:D1").Select相关清数逻辑失效的根本原因。
• 复制逻辑冗余冲突：代码先执行了sht2.Range("O6:P102").Copy，后面又重新选区域做第二次复制，第一次复制的内容会被直接覆盖，第二次选中逻辑同样因为工作表未激活失效。
• 范围定位逻辑有漏洞：用End(xlDown)从表头向下选范围的写法，遇到列中存在空行就会提前终止，无法覆盖所有存量数据。

最佳实践原则 #

VBA操作单元格时全程不需要激活工作表、不需要使用Select/Selection，直接通过工作表对象引用操作范围，是稳定性最高、运行效率最快的写法，可以完全规避激活状态、屏幕刷新带来的各类异常。

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

Sub ImportData()
    Dim wkb1 As Workbook
    Dim sht1 As Worksheet
    Dim wkb2 As Workbook
    Dim sht2 As Worksheet
    Dim lastClearRow As Long
    Dim lastSourceRow As Long
    Dim lastSourceCol As Long

    ' 关闭屏幕刷新和系统弹窗，提升运行速度、避免流程被打断
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wkb1 = ThisWorkbook
    Set sht1 = wkb1.Sheets("Data")
    Set wkb2 = Workbooks.Open("C:\Users\Temp\Desktop\MyExcelSheet.xlsm")
    Set sht2 = wkb2.Sheets("Summary")

    ' 清空目标表A-D列存量数据：从列底部向上定位最后一行非空单元格，避免空行截断问题
    lastClearRow = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
    If lastClearRow < 1 Then lastClearRow = 1
    sht1.Range("A1:D" & lastClearRow).ClearContents

    ' 定位源表O6为起点的连续数据块范围
    lastSourceRow = sht2.Cells(sht2.Rows.Count, "O").End(xlUp).Row
    lastSourceCol = sht2.Cells(6, sht2.Columns.Count).End(xlToLeft).Column
    ' 直接执行值粘贴，跳过选中步骤
    sht2.Range(sht2.Cells(6, "O"), sht2.Cells(lastSourceRow, lastSourceCol)).Copy
    sht1.Range("A1").PasteSpecial xlPasteValues

    ' 清理剪贴板、关闭源工作簿
    Application.CutCopyMode = False
    wkb2.Close SaveChanges:=True
    
    ' 恢复系统设置
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Complete"
End Sub

优化点说明 #

• 移除了所有Select、Selection相关逻辑，所有范围操作直接绑定对应工作表对象，不需要激活工作表即可稳定运行，不会出现范围错位问题。
• 范围定位逻辑改为从工作表边缘向数据区域查找最后一行/列，不会因为数据中间存在空行漏清、漏选数据。
• 删除了重复复制的冗余代码，减少不必要的剪贴板操作，运行速度更快。
• 补充了系统弹窗开关，避免打开、关闭工作簿时的更新提示、保存提示中断流程。

内容的提问来源于stack exchange，提问作者Sir.Socks