Creating a new Word document from each row of Excel data

Question

I have a document template which needs to be filled in with data from my workbook - I've managed to get it to put the correct data at the correct part of the Word doc with bookmarks, but would like it to do a new doc for each line.

The code below will put the data in, and in column Y will put a yes when it has copied the data, however it currently tries doing every row in the same document rather than the new document with the pasted table in.

Public Sub openExistingWordFile()

   Dim objWord
   Dim objDoc
   Dim objRange

   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Open(".... Draft Invoice Template.doc")

   objWord.Visible = True

   objWord.Selection.WholeStory
   objWord.Selection.Copy


 R = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 6 To R
        With Cells(i, 2)
            If .Value <> "" And Cells(i, 25) = "" Then
                Cells(i, 25) = "Yes"

    Set objRange = objDoc.Bookmarks("OurRef").Range
    objRange.InsertAfter Cells(i, 4)

    Set objRange = objDoc.Bookmarks("WorkRef").Range
    objRange.InsertAfter Cells(i, 5)

    Set objRange = objDoc.Bookmarks("Location").Range
    objRange.InsertAfter Cells(i, 7)

    Set objRange = objDoc.Bookmarks("WorksType").Range
    objRange.InsertAfter Cells(i, 11)

    Set objRange = objDoc.Bookmarks("ReinCat").Range
    objRange.InsertAfter Cells(i, 12)

    Set objRange = objDoc.Bookmarks("TS").Range
    objRange.InsertAfter Cells(i, 13)

    Set objRange = objDoc.Bookmarks("Charge").Range
    objRange.InsertAfter Cells(i, 18)

    Set objRange = objDoc.Bookmarks("From").Range
    objRange.InsertAfter Cells(i, 15)

    Set objRange = objDoc.Bookmarks("To").Range
    objRange.InsertAfter Cells(i, 16)

    Set objRange = objDoc.Bookmarks("Days").Range
    objRange.InsertAfter Cells(i, 17)

    Set objRange = objDoc.Bookmarks("Total").Range
    objRange.InsertAfter Cells(i, 24)

    Set objRange = objDoc.Bookmarks("Date").Range
    objRange.InsertDateTime DateTimeFormat:="d/M/yyyy"


    objWord.Documents.Add DocumentType:=wdNewBlankDocument
    objWord.Activate
    objWord.Selection.PasteAndFormat (wdUseDestinationStylesRecovery)

        End If
        End With

    Next i


    End Sub

It would help to save your documents after each iteration. Now you just continue your iteration Next i and overwrite values after each bookmark. — JvdV
Because they will need to be saved in different locations I don't want to save them after each iteration, I've managed to get it to copy the original template and paste into a new document, but it then inserts the ranges into the original document still (code edited above) — ffc2004
Then create a new objWord.Documents.Open(".....Draft Invoice Template.doc") starting each iteration? — JvdV
I'd prefer for it to copy the template to a new word doc, paste it, and then insert the next row of values on there if possible? — ffc2004
Possible duplicate of Copying Excel data into specific sections of a Word document — macropod

ffc2004 ffc2004 · Accepted Answer · 2019-04-11T08:11:02

I did eventually manage to sort this, code below if anyone is interested.

Public Sub openExistingWordFile()

   Dim objWord
   Dim objDoc
   Dim objRange

   Set objWord = CreateObject("Word.Application")
   Set objDoc = objWord.Documents.Add(Template:="...S74 Draft Invoice Template.doc", NewTemplate:=False, DocumentType:=0)

   objWord.Visible = True


r = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 6 To r
        With Cells(i, 2)
            If .Value <> "" And Cells(i, 25) = "" Then
                Cells(i, 25) = "Yes"

    Set objRange = objDoc.Bookmarks("OurRef").Range
    objRange.InsertAfter Cells(i, 4)

    Set objRange = objDoc.Bookmarks("WorkRef").Range
    objRange.InsertAfter Cells(i, 5)

    Set objRange = objDoc.Bookmarks("Location").Range
    objRange.InsertAfter Cells(i, 7)

    Set objRange = objDoc.Bookmarks("WorksType").Range
    objRange.InsertAfter Cells(i, 11)

    Set objRange = objDoc.Bookmarks("ReinCat").Range
    objRange.InsertAfter Cells(i, 12)

    Set objRange = objDoc.Bookmarks("TS").Range
    objRange.InsertAfter Cells(i, 13)

    Set objRange = objDoc.Bookmarks("Charge").Range
    objRange.InsertAfter Cells(i, 18)

    Set objRange = objDoc.Bookmarks("From").Range
    objRange.InsertAfter Cells(i, 15)

    Set objRange = objDoc.Bookmarks("To").Range
    objRange.InsertAfter Cells(i, 16)

    Set objRange = objDoc.Bookmarks("Days").Range
    objRange.InsertAfter Cells(i, 17)

    Set objRange = objDoc.Bookmarks("Total").Range
    objRange.InsertAfter Cells(i, 24)

    Set objRange = objDoc.Bookmarks("Date").Range
    objRange.InsertDateTime DateTimeFormat:="d/M/yyyy"

    Set objDoc = objWord.Documents.Add(Template:="...S74 Draft Invoice Template.doc", NewTemplate:=False, DocumentType:=0)

    objWord.Activate


        End If
        End With

    Next i

    objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

    End Sub

Creating a new Word document from each row of Excel data

1 Answers