如何提升外部工作表复制粘贴的VBA代码运行速度？

核心优化点 #

• 禁用Excel界面刷新与事件：打开文件、粘贴时的界面刷新是耗时大户，先关闭这些非必要操作，最后恢复默认设置
• 减少输出工作簿的打开/关闭次数：原代码每个i循环都重复打开输出文件，改成j循环开始时打开一次，循环结束后再保存关闭，一次打开可复用10次
• 用数组赋值替代剪贴板复制粘贴：剪贴板属于交互级操作，速度远不如内存数组直接读写
• 明确对象引用：避免使用ActiveWorkbook、未限定的Range，用变量绑定工作簿/工作表，减少Excel的对象查找开销
• 缩小操作区域：不要用整列（比如A:BA）粘贴，只针对实际数据大小操作，避免空单元格的无效处理

修改后的完整代码 #

Sub OptimizedDataTransfer()
    Dim wbInput As Workbook
    Dim wbOutput As Workbook
    Dim wsInput As Worksheet
    Dim wsOutput As Worksheet
    Dim sourceData As Variant
    Dim targetStartCol As String
    Dim targetRange As Range
    
    ' 关闭非必要功能，大幅提速
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual ' 手动计算，避免每次粘贴触发重算
    End With
    
    For j = 2 To 5
        ' 仅打开一次输出工作簿，循环内复用
        Set wbOutput = Workbooks.Open(Filename:=Output_Paths(j))
        
        For i = 1 To 10
            ' 打开输入文件并绑定对象
            Set wbInput = Workbooks.Open(Filename:=Paths_Inputs_Total(i))
            Set wsInput = wbInput.Sheets(1) ' 假设数据在第一个工作表，可根据实际调整
            
            ' 把源数据读取到内存数组
            sourceData = wsInput.Range("A1").CurrentRegion.Value
            
            ' 确定目标工作表和起始列
            Set wsOutput = wbOutput.Sheets(Output_Tabs_Total(i))
            Select Case True
                Case InStr(1, Output_Tabs_Total(i), "AP") <> 0
                    targetStartCol = "A"
                Case InStr(1, Output_Tabs_Total(i), "Info MP") <> 0
                    targetStartCol = "D"
                Case Else
                    targetStartCol = "C"
            End Select
            
            ' 计算目标区域，仅覆盖实际数据大小
            Set targetRange = wsOutput.Range(targetStartCol & "1").Resize(UBound(sourceData, 1), UBound(sourceData, 2))
            ' 数组直接赋值，跳过剪贴板
            targetRange.Value = sourceData
            
            ' 关闭输入文件，无需保存（仅读取操作）
            wbInput.Close SaveChanges:=False
        Next i
        
        ' 所有i循环完成后，统一保存关闭输出文件
        wbOutput.Save
        wbOutput.Close
        Set wbOutput = Nothing ' 释放对象内存
    Next j
    
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

额外注意事项 #

• 如果输入文件的数据源不在第一个工作表，修改Set wsInput = wbInput.Sheets(1)为对应工作表名或索引
• 确保Paths_Inputs_Total、Output_Paths、Output_Tabs_Total这些变量的路径和表名准确，避免对象引用错误
• 若数据量极大，可考虑分块处理数组，但大部分场景下上述代码已足够实现显著提速

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