请求编写VBA循环实现跨工作簿数据复制与批量保存功能

需求说明 #

• 从「CC input.xlsm」的Inputs工作表逐行读取数据
• 打开模板「NoHarvest_Maintenance.xlsx」并填入对应行数据
• 将模板计算结果复制回「CC input.xlsm」的Outputs工作表
• 模板以动态生成的唯一标识（如Unit1_、Unit2_）命名另存到独立文件夹
• 循环处理直至Inputs工作表无数据

原代码仅支持单行数据处理，以下是优化后的完整实现：

优化后完整代码 #

Sub BatchCopyOverNoHarvMAINT()
    Dim wbInput As Workbook
    Dim wsInputs As Worksheet
    Dim wsOutputs As Worksheet
    Dim wbTemplate As Workbook
    Dim templatePath As String
    Dim saveBasePath As String
    Dim saveFolderPath As String
    Dim lastRow As Long
    Dim i As Long
    
    ' 配置文件路径，根据实际情况修改
    templatePath = "C:\Users\Desktop\Carbon Calc\NoHarvest_Maintenance.xlsx"
    saveBasePath = "C:\Users\Desktop\Carbon Calc\"
    saveFolderPath = saveBasePath & "ProcessedUnits\" ' 独立保存文件夹
    
    ' 绑定原工作簿及工作表
    Set wbInput = ThisWorkbook
    Set wsInputs = wbInput.Worksheets("Inputs")
    Set wsOutputs = wbInput.Worksheets("Outputs")
    
    ' 创建独立保存目录（不存在则自动创建）
    On Error Resume Next
    MkDir saveFolderPath
    On Error GoTo 0
    
    ' 关闭屏幕更新提升运行效率
    Application.ScreenUpdating = False
    
    ' 获取Inputs表最后一行数据行号
    lastRow = wsInputs.Cells(wsInputs.Rows.Count, "B").End(xlUp).Row
    
    ' 逐行循环处理（假设数据从第5行开始，表头在1-4行）
    For i = 5 To lastRow
        ' 打开模板工作簿
        Set wbTemplate = Workbooks.Open(templatePath)
        
        ' 将Inputs表当前行数据写入模板对应单元格
        With wbTemplate.Worksheets(1)
            .Range("C3").Value = wsInputs.Cells(i, "B").Value
            .Range("C5").Value = wsInputs.Cells(i, "C").Value
            .Range("C6").Value = wsInputs.Cells(i, "D").Value
            .Range("C7").Value = wsInputs.Cells(i, "E").Value
        End With
        
        ' 将模板计算结果写入Outputs表对应行
        wsOutputs.Cells(i, "B").Value = wbTemplate.Worksheets(1).Range("H10").Value
        wsOutputs.Cells(i, "C").Value = wbTemplate.Worksheets(1).Range("R10").Value
        
        ' 保存模板为带动态标识的文件，编号从1开始
        wbTemplate.SaveAs _
            Filename:=saveFolderPath & "Unit" & (i - 4) & "_NoHarvest_Maintenance.xlsx", _
            FileFormat:=xlOpenXMLWorkbook
            
        ' 关闭模板，无需保存更改（已另存为新文件）
        wbTemplate.Close SaveChanges:=False
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "批量处理完成！", vbInformation
End Sub

关键改进点 #

• 批量循环逻辑：通过lastRow获取数据范围，用For循环逐行处理所有数据
• 动态标识生成：利用循环变量计算生成Unit1_、Unit2_格式的唯一文件名前缀
• 独立文件夹管理：自动创建ProcessedUnits子文件夹，避免文件混乱
• 效率优化：取消不必要的Select/Activate操作，直接引用对象，提升运行速度
• 容错处理：自动创建文件夹，避免路径不存在导致的错误
• 用户反馈：处理完成后弹出提示框，明确告知结果

使用注意事项 #

• 请根据实际文件位置修改templatePath和saveBasePath的路径值
• 如果Inputs表的数据起始行不是第5行，修改For i = 5 To lastRow中的起始数字，并同步调整Unit编号的计算式（比如起始行是2，编号改为i-1）
• 若模板使用特定工作表名称，将wbTemplate.Worksheets(1)替换为wbTemplate.Worksheets("工作表名称")

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