Macro to create many word documents (need for a loop or something)

[rockdrigotoca]

Hi there!!

I am trying to create word documents from the cells I have in Excel. So far I have managed to create 1! But what if I have more than one data on Excel??

On Excel, Sheet1 I have row 1 as Titles for Address_Name, Address1, Address2, Letter_Date, Salutation, Owed_Amount. I have the same in a word document marked as bookmarks. So the macro already sends that info but just for Row2.

Could you please help me if I need to extend that macro to all rows from Excel? The number of letters (and data) may vary.

Please help!!

The code is:

Option Explicit

Sub ExcelCells_to_Word()

Dim WdApp As Object, wd As Object, ac As Long, ws As Worksheet
Dim wsData As Worksheet
Dim wsControl As Worksheet
Set ws = Worksheets("Sheet1")
Set WdApp = CreateObject("Word.Application")
Set wd = WdApp.Documents.Open("C:\Debt Recovery Letters\Word Template\TestLetter.doc")
WdApp.Visible = True
Dim rng1 As Range


 Dim m As Long
m = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("A2:A" & m).Select

Set rng1 = wsData.Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
' I am not sure if this is the way to go to create the loop, please help!!

For Each rng1 In Worksheets("Sheet1")

With wd.Bookmarks
.Item("Address_Name").Range.InsertAfter Worksheets("Sheet1").Range("A2").Value
.Item("Address1").Range.InsertAfter Worksheets("Sheet1").Range("B2").Value
.Item("Address2").Range.InsertAfter Worksheets("Sheet1").Range("C2").Value
.Item("Letter_Date").Range.InsertAfter Worksheets("Sheet1").Range("D2").Value
.Item("Salutation").Range.InsertAfter Worksheets("Sheet1").Range("E2").Value
.Item("Owed_Amount").Range.InsertAfter Worksheets("Sheet1").Range("F2").Value

End With

Next rng1

 

[jbeaucaire]

Maybe this:

Option Explicit

Sub ExcelCells_to_Word()

Dim WdApp As Object:     Set WdApp = CreateObject("Word.Application")
Dim wd As Object:        Set wd = WdApp.Documents.Open("C:\Debt Recovery Letters\Word Template\TestLetter.doc")
Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("Sheet1")
Dim LR As Long           'last row with data
Dim Rw As Long           'looping variable

WdApp.Visible = True

LR = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Row
For Rw = 2 To LR
    With wd.Bookmarks
        .Item("Address_Name").Range.InsertAfter wsData.Range("A" & Rw).Value
        .Item("Address1").Range.InsertAfter wsData.Range("B" & Rw).Value
        .Item("Address2").Range.InsertAfter wsData.Range("C" & Rw).Value
        .Item("Letter_Date").Range.InsertAfter wsData.Range("D" & Rw).Value
        .Item("Salutation").Range.InsertAfter wsData.Range("E" & Rw).Value
        .Item("Owed_Amount").Range.InsertAfter wsData.Range("F" & Rw).Value
    End With
Next Rw

End Sub

 

[rockdrigotoca]

Hi Jerry!!

Thanks for your answer! Although now it goes by the entire set of data in excel, it only creates one page on Word, lol. So on the Address_Name bookmark on word, I finished with something like:
Address_NameJuan PerezRodrigo TocaTony Briggs...

I tried saving the word document as .dot, really a template and updated the code but still the same result =S

Would you know how to create one letter for each person, Juan, Rodrigo and Tony?
Or would it be better to do the Code as MailMerge in word and then paste it into the excel module?

Again, thanks for the answer!!

 

[jbeaucaire]

Maybe this:

Option Explicit

Sub ExcelCells_to_Word()

Dim WdApp As Object:     Set WdApp = CreateObject("Word.Application")
Dim wd As Object
Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("Sheet1")
Dim LR As Long           'last row with data
Dim Rw As Long           'looping variable

WdApp.Visible = True

LR = wsData.Range("A" & wsData.Rows.Count).End(xlUp).Row
For Rw = 2 To LR
    Set wd = WdApp.Documents.Open("C:\Debt Recovery Letters\Word Template\TestLetter.doc")
    With wd.Bookmarks
        .Item("Address_Name").Range.InsertAfter wsData.Range("A" & Rw).Value
        .Item("Address1").Range.InsertAfter wsData.Range("B" & Rw).Value
        .Item("Address2").Range.InsertAfter wsData.Range("C" & Rw).Value
        .Item("Letter_Date").Range.InsertAfter wsData.Range("D" & Rw).Value
        .Item("Salutation").Range.InsertAfter wsData.Range("E" & Rw).Value
        .Item("Owed_Amount").Range.InsertAfter wsData.Range("F" & Rw).Value
    End With
    'some line of code here to save the letter
Next Rw

End Sub

 

[rockdrigotoca]

Hey jbeaucaire!!

Yup, that's actually what I need. Still finding out how to close Word without saving it but it's a very good solution!! I managed to print the first one (rather than saving it) and put ActiveWindow.Close so my Excel workbook closed!

Anyhow, thank you very much for the solution, I think with this I can do it!! I will post the result of this when I get it!