Excel to Word Doc VBA modification

[MWhiteDesigns]

Good morning,
I have a routine that a co worker made that needs to be tweaked (shown below).

I have a excel sheet that has 4 columns. The values for each row currently get placed into the word documents text fields. Once the row is completed, it saves the file and opens up a new word document to do the same with the next row.

I need to change this to continually place the values of each row until into the word doc text fields until there are no more text fields. e.g. column value 1,2,3,4 of row 1 gets placed in the first 4 text fields, then excel goes to the next row (instead of saving the document) and places the values for the next for of column 1,2,3,4 into the next 4 text fields and so on.

Thanks in advance!

Sub Populate_Template()
sPath = "\\*********\ID\ID_3002_Letters\"
        
Dim wd As Object
Set wd = CreateObject("Word.Application")


FileToOpen = ActiveSheet.Name & ".docx"


wd.Visible = True


wd.Documents.Open sPath & FileToOpen


'Loop through form elements here
iRow = 3
Do Until ActiveSheet.Cells(iRow, 1) = ""
iCol = 1
    Do Until Cells(1, iCol) = ""
        dObj = ActiveSheet.Cells(1, iCol)
        dVal = ActiveSheet.Cells(iRow, iCol)
        wd.activedocument.FormFields(dObj).Result = dVal
        iCol = iCol + 1
    Loop
    LtrSaveName = sPath & Cells(iRow, 1) & " - " & FileToOpen
    wd.activedocument.SaveAs2 (LtrSaveName)
    iRow = iRow + 1
Loop


wd.Quit


Set wd = Nothing


MsgBox "All done populating the template. Please review output at: " & sPath


End Sub

 

[Worf]

Good evening

The code below refers to the Word fields by index:

Sub Populate_Template()
Dim wd As Object, rw%, pth, FileToOpen$, col%, wf%, doc As Document
pth = Split(Environ(29), "=")(1) & "\"
Set wd = CreateObject("Word.Application")
FileToOpen = ActiveSheet.Name & ".docm"
wd.Visible = True
wd.Documents.Open pth & FileToOpen
Set doc = wd.ActiveDocument
rw = 3: wf = 1
Do Until ActiveSheet.Cells(rw, 1) = "" Or wf > doc.FormFields.Count
    col = 1
    Do Until Cells(rw, col) = ""
        doc.FormFields(wf).Result = ActiveSheet.Cells(rw, col)
        col = col + 1
        wf = wf + 1
    Loop
    rw = rw + 1
Loop
doc.SaveAs2 pth & Cells(rw - 1, col - 1) & "-" & FileToOpen
'wd.Quit
Set wd = Nothing
MsgBox "All done populating the template. Please review output at: " & pth
End Sub