我看了你现有的VBA代码，它能完成跨工作簿指定行的复制，但进度条没有真正做到每完成一行就更新。我帮你重构了代码，把重复的复制粘贴逻辑改成了循环处理，同时实现了每完成一个复制任务就实时更新进度的功能，具体调整如下：

优化后的完整代码 #

Sub Automate_Estimate()
    Dim Wb As Workbook, wkb As Workbook
    Dim MyFile As Variant
    Dim totalTasks As Integer, currentTask As Integer
    Dim copyPairs As Variant ' 存储源范围和目标单元格的配对
    Dim SourceName As String, DestName As String
    
    ' 请在这里填写你的源工作表名和目标工作表名
    SourceName = "源工作表名称"
    DestName = "目标工作表名称"
    
    ' 初始化工作簿对象
    Set Wb = ThisWorkbook
    MyFile = Application.GetOpenFilename(FileFilter:="Excel Files,*.xl*;*.xm*")
    If MyFile = False Then Exit Sub ' 用户取消选择文件时直接退出
    
    Set wkb = Workbooks.Open(MyFile, UpdateLinks:=0)
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行速度
    
    ' 定义所有需要复制的源范围和目标单元格的配对
    copyPairs = Array( _
        Array("C12:R12", 1, 2), _
        Array("C30:R30", 24, 2), _
        Array("C22:R22", 4, 2), _
        Array("C20:R20", 14, 2), _
        Array("C40:R40", 17, 2), _
        Array("C16:R16", 7, 2), _
        Array("C17:R17", 8, 2), _
        Array("C21:R21", 16, 2), _
        Array("C52:R52", 56, 2) _
    )
    
    totalTasks = UBound(copyPairs) + 1 ' 计算总任务数
    currentTask = 0
    
    ' 循环处理每一个复制任务
    For Each pair In copyPairs
        currentTask = currentTask + 1
        
        ' 更新状态栏进度，显示整数百分比
        Application.StatusBar = "Copying In progress..." & Round((currentTask / totalTasks) * 100, 0) & "% completed"
        
        ' 执行复制粘贴（仅粘贴值）
        Sheets(SourceName).Range(pair(0)).Copy
        Wb.Sheets(DestName).Cells(pair(1), pair(2)).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            
        DoEvents ' 让Excel及时响应状态栏更新，确保进度实时显示
    Next pair
    
    ' 完成后的状态提示
    Application.StatusBar = "Copying Is complete"
    Application.ScreenUpdating = True ' 恢复屏幕刷新
    
    wkb.Close SaveChanges:=False ' 关闭源工作簿，不保存更改
    ' 释放对象内存
    Set wkb = Nothing
    Set Wb = Nothing
End Sub

关键改进点说明 #

• 任务配对数组：把所有需要复制的源范围和目标单元格整理成二维数组，既避免了重复代码，也方便统计总任务数
• 实时进度更新：每完成一个复制任务就计算当前完成百分比，用Round函数保证进度显示为整数，更直观
• DoEvents语句：让Excel在执行复制的间隙更新状态栏，确保进度能实时显示出来，不会卡顿
• 屏幕刷新控制：关闭ScreenUpdating可以大幅提升代码运行速度，完成后再恢复默认设置
• 异常防护：增加了用户取消选择文件时的退出逻辑，避免出现报错

注意：一定要在代码开头填写你的SourceName（源工作表名称）和DestName（目标工作表名称），否则代码会执行失败。

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