如何通过VBA循环实现Excel逐行填充表单并按不同名称保存

核心改造逻辑 #

• 自动识别源表有效数据范围，从第2行（表头下第一行）开始逐行遍历
• 每次生成表单前重新加载空白模板，避免上一轮填充的数据残留
• 用单元格直接赋值替代剪贴板复制粘贴，运行效率更高，不干扰用户剪贴板内容
• 文件名按行号自动递增，支持自定义为业务字段命名，避免重名覆盖

完整可用代码 #

Sub BatchGenerateVouchers()
    Dim shtCopy As Worksheet
    Dim wbVoucherTemplate As Workbook
    Dim lastRow As Long
    Dim i As Long
    Dim saveRootPath As String
    Dim fileNamePrefix As String
    
    ' --------------------------
    ' 配置项：按需修改以下参数
    ' --------------------------
    saveRootPath = "C:\Users\computer\Documents\file\" ' 生成文件的保存目录
    fileNamePrefix = "vouc" ' 生成文件名的前缀
    Const VOUCHER_TEMPLATE_PATH As String = "C:\Users\computer\Documents\file\NJT VOUCHER.xlsx" ' 模板文件完整路径
    
    ' 检查源工作簿是否已打开
    On Error Resume Next
    Set shtCopy = Workbooks("NJT COPY").Worksheets("Sheet1")
    On Error GoTo 0
    If shtCopy Is Nothing Then
        MsgBox "请先打开「NJT COPY」源数据工作簿后再运行宏！"
        Exit Sub
    End If
    
    ' 计算源表C列最后一行有效数据行号，避免空行漏判
    lastRow = shtCopy.Cells(shtCopy.Rows.Count, "C").End(xlUp).Row
    
    ' 逐行遍历处理数据
    For i = 2 To lastRow
        ' 打开干净的模板文件
        Set wbVoucherTemplate = Workbooks.Open(Filename:=VOUCHER_TEMPLATE_PATH)
        
        ' 字段映射赋值，和原有字段对应关系完全一致
        wbVoucherTemplate.Worksheets("Sheet1").Range("E4").Value = shtCopy.Range("C" & i).Value
        wbVoucherTemplate.Worksheets("Sheet1").Range("B4").Value = shtCopy.Range("D" & i).Value
        wbVoucherTemplate.Worksheets("Sheet1").Range("F41").Value = shtCopy.Range("H" & i).Value
        wbVoucherTemplate.Worksheets("Sheet1").Range("F5").Value = shtCopy.Range("I" & i).Value
        
        ' 保存并关闭当前生成的表单
        wbVoucherTemplate.SaveAs Filename:=saveRootPath & fileNamePrefix & i
        wbVoucherTemplate.Close
        Set wbVoucherTemplate = Nothing
    Next i
    
    ' 释放对象
    Set shtCopy = Nothing
    MsgBox "处理完成，共生成 " & lastRow - 1 & " 份表单！"
End Sub

使用说明 #

• 把代码里VOUCHER_TEMPLATE_PATH常量的值改成你自己「NJT VOUCHER」模板文件的实际存放完整路径
• 如果需要用业务字段作为文件名（比如用D列的单据编号命名），把保存行的fileNamePrefix & i替换为shtCopy.Range("D" & i).Value即可
• 如果源表数据不是从第2行开始，修改循环语句For i = 2 To lastRow里的起始值2即可
• 运行前请确保Excel已启用宏权限

如果需要保留原复制粘贴的格式（而非仅粘贴值），可以把代码里直接赋值的部分换回原有的Copy+PasteSpecial xlPasteValues写法，仅需把原代码里固定的行号2替换为循环变量i即可。

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