寻求高效VBA循环复制特定列数据至另一工作簿的解决方案

我来帮你解决这个需求——实现高效的VBA循环，10次将源工作簿指定区域的非空行数据复制到目标工作簿的C列，每次粘贴到最后非空单元格下方。先聊聊你现有代码的几个问题：

• 大量使用Select/Activate：这是VBA里效率极低且容易触发错误的操作，完全可以通过直接引用对象替代
• 缺少忽略空行的逻辑：现有代码会把空行也复制过去
• 没有完整的10次循环结构：当前代码只是零散的复制操作，没有循环控制
• 存在拼写错误：ActivCell应该是ActiveCell

下面是优化后的高效版本代码，我会逐段解释：

Sub FastCopyLoop()
    ' 声明变量
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim srcRange As Range
    Dim destLastRow As Long
    Dim i As Integer
    
    ' 提升运行速度：关闭屏幕更新、事件触发等
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 引用源工作簿（假设当前运行宏的工作簿就是源工作簿）
    Set srcWB = ThisWorkbook
    ' 打开并引用目标工作簿
    Set destWB = Workbooks.Open("C:\Users\Manzurfa\Desktop\1. Forecast Amalgamation.xlsx")
    
    ' 循环执行10次
    For i = 1 To 10
        ' 获取源区域中的非空行（只复制有数据的行）
        On Error Resume Next ' 防止区域全为空时出错
        Set srcRange = srcWB.Sheets("你的源工作表名称").Range("A16:J1338").SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        
        If Not srcRange Is Nothing Then
            ' 找到目标工作簿C列的最后非空行
            destLastRow = destWB.Sheets("你的目标工作表名称").Cells(destWB.Sheets("你的目标工作表名称").Rows.Count, "C").End(xlUp).Row
            ' 如果C列是空的，从第1行开始；否则从最后一行的下一行开始
            destLastRow = IIf(destLastRow = 1 And destWB.Sheets("你的目标工作表名称").Range("C1").Value = "", 1, destLastRow + 1)
            
            ' 直接赋值（比Copy/Paste快得多）
            srcRange.Copy
            destWB.Sheets("你的目标工作表名称").Range("C" & destLastRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' 根据需求选择粘贴类型
            
            ' 清空对象引用
            Set srcRange = Nothing
        End If
    Next i
    
    ' 保存目标工作簿并关闭
    destWB.Save
    destWB.Close SaveChanges:=False ' 已经Save过，这里可以False
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "循环复制完成！"
End Sub

关键优化点说明： #

• 避免Select/Activate：通过直接引用Workbook、Worksheet、Range对象，彻底告别低效的界面操作
• 忽略空行：使用SpecialCells(xlCellTypeConstants)筛选出区域内有常量数据的行，如果需要包含公式数据，可以改成xlCellTypeCellValue
• 高效粘贴：使用PasteSpecial指定粘贴类型（比如值和格式），或者直接用destRange.Value = srcRange.Value（如果只需要值的话更快）
• 速度优化：关闭屏幕更新、自动计算和事件触发，大幅提升循环运行效率
• 错误处理：加入On Error Resume Next防止源区域全为空时触发错误

注意事项： #

1. 请把代码中的"你的源工作表名称"和"你的目标工作表名称"替换成实际的工作表名称
2. 如果源工作簿不是当前运行宏的工作簿，可以改成Set srcWB = Workbooks.Open("源工作簿路径")，记得最后关闭它
3. 如果需要复制公式而不是值，把xlPasteValuesAndNumberFormats改成xlPasteAll即可

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