嘿，我来帮你搞定这个循环生成Word文档的问题！你之前尝试的循环写法不仅逻辑不完整，还依赖ActiveCell这种容易出问题的操作，难怪程序会崩溃。咱们重新调整代码，完美实现每行数据生成一个独立Word文档的需求。

原有代码的核心问题 #

原来的代码只能固定处理第2行的数据，完全没有循环逻辑；你试的Range("e5").Select Do Until...既没有循环体，也没处理Word文档的新建/保存/关闭，导致Word进程堆积、内存溢出，最终崩溃。

修改后的完整VBA代码 #

Sub CreateWR_ForEachRow()
    Dim ws As Worksheet
    Dim objWord As Object
    Dim lastRow As Long
    Dim i As Long
    Dim savePath As String
    
    ' 配置基础参数：工作表和保存路径
    Set ws = ThisWorkbook.Sheets("Sheet1")
    savePath = "C:\User\Documents\FileControl\" ' 生成文档的保存目录
    
    ' 获取数据的最后一行（以A列为准，可根据你的表头列调整）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 启动Word应用，后台运行加快速度（调试时可改成True）
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False
    
    ' 错误处理：确保即使出错，Word进程也能正常退出
    On Error GoTo Cleanup
    
    ' 循环处理每一行数据（从第2行开始，第1行是表头）
    For i = 2 To lastRow
        ' 打开模板文档
        objWord.Documents.Open savePath & "template.doc"
        
        With objWord.ActiveDocument
            ' 填充对应书签，用行号i代替固定的2，匹配当前行数据
            .Bookmarks("PropertyName").Range.Text = ws.Range("A" & i).Value
            .Bookmarks("ProjectNumber").Range.Text = ws.Range("B" & i).Value
            .Bookmarks("BudgetNumber").Range.Text = ws.Range("C" & i).Value
            .Bookmarks("ProjecName").Range.Text = ws.Range("D" & i).Value ' 注意：原代码拼写是ProjecName，确认模板书签名称一致
            .Bookmarks("Vendor_1").Range.Text = ws.Range("E" & i).Value
            .Bookmarks("Price_1").Range.Text = ws.Range("F" & i).Value
            .Bookmarks("Vendor_2").Range.Text = ws.Range("G" & i).Value
            .Bookmarks("Price_2").Range.Text = ws.Range("H" & i).Value
            .Bookmarks("Vendor_3").Range.Text = ws.Range("I" & i).Value
            .Bookmarks("Price_3").Range.Text = ws.Range("J" & i).Value
            .Bookmarks("Vendor_1_2").Range.Text = ws.Range("E" & i).Value
            .Bookmarks("RequestedBy").Range.Text = ws.Range("M" & i).Value
            
            ' 保存为独立文档，用项目编号命名（可自定义命名规则）
            .SaveAs2 savePath & "WR_" & ws.Range("B" & i).Value & ".docx"
            
            ' 关闭当前文档，避免内存占用过高
            .Close SaveChanges:=False
        End With
    Next i
    
Cleanup:
    ' 收尾：退出Word并释放资源
    objWord.Quit
    Set objWord = Nothing
    Set ws = Nothing
    
    MsgBox "所有文档已生成完成！", vbInformation
End Sub

关键改进点说明 #

• 抛弃ActiveCell，用行号定位：用循环变量i匹配每行单元格，比依赖ActiveCell稳定得多，不会因为手动点击单元格导致逻辑混乱
• 完整的循环逻辑：从第2行遍历到最后一行有数据的行，逐行处理
• 及时关闭文档：每次处理完一行就关闭当前Word文档，避免同时打开大量文档导致内存溢出
• 后台运行Word：Visible = False大幅提升处理速度，调试时可以改成True查看过程
• 错误处理机制：确保即使中途出错，Word进程也能正常退出，不会残留后台僵尸进程
• 自定义命名规则：用项目编号作为文件名，方便快速区分每个生成的文档

额外注意事项 #

1. 确认模板文件路径和书签名称完全匹配（比如原代码里的ProjecName如果是拼写错误，要和模板里的书签一致）
2. 如果保存目录不存在，可以添加代码自动创建：If Dir(savePath, vbDirectory) = "" Then MkDir savePath
3. 如果需要填充后保留书签，可以在填充前先保存书签范围，填充后重新添加：

   Dim bmkRange As Object
   Set bmkRange = .Bookmarks("PropertyName").Range
   bmkRange.Text = ws.Range("A" & i).Value
   .Bookmarks.Add "PropertyName", bmkRange
   

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