Saving and merging Word docs from Excel Sheet

[Tombstone07]

Hello VBAExpress community!

I've been Reading from the answers given through these fórums and it's been great so far...

Right now I have an Excel Sheet, in it I run a Macro that checks values in a column, opens a Word Doc and populates it with the relevant information found in the active row; this opens several files, and I was hoping to find a way in which all these documents could be opened as a single file; or that, once the code saves them, have the option to merge all files into one.


Dim wrdLttrX As Object
Dim fnameX As String
fnameX = "Carta X" 'change to suit
Dim ws As Worksheet
Dim wrdLttrY As Object
Dim fnameY As String
fnameY = "Carta Y" 'change to suit

Range("E11").Select
Do While (Left(ActiveCell.Value, 2) = "X " Or Left(ActiveCell.Value, 2) = "Y ")
For Each CeldaFigura In Selection

Set ws = ThisWorkbook.ActiveSheet
Set wrdLttrX = CreateObject("Word.Application")
Set wrdLttrY = CreateObject("Word.Application")

If (Left(ActiveCell.Value, 2) = "X ") Then

wrdLttrX.Documents.Open (ThisWorkbook.Sheets("Parámetros").Range("B2").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrX.Visible = True

With wrdLttrX
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameX & DocNum & ".docx", FileFormat:=wdFormatDocument
End With

With wrdLttrX.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With

End If

If (Left(ActiveCell.Value, 2) = "Y ") Then

wrdLttrY.Documents.Open (ThisWorkbook.Worksheets("Parámetros").Range("B4").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrY.Visible = True
With wrdLttrY
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameY & DocNum & ".docx", FileFormat:=wdFormatDocument
End With

With wrdLttrY.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With

End If

Next CeldaFigura
ActiveCell.Offset(1, 0).Select

Loop
End Sub


This is the section of the Code that Opens a Word template, populates the text with the infor in the Excel table, and "saves" it.

I need a way to either make it open all the docs in one file (with pagebreaks if posible to make it look organized) or once they are saves, merge them.