Copy and Paste Page to Each Row in Excel

[D_Marcel]

Dears,

Greetings!
I'm facing a very tricky situation related to the MS Word, since I don't know any VBA object to this application. I'm in a system implementation project and I have to perform more than two hundred test scenarios, each one properly evidenced and documented. I have all these scenarios organized in a Worksheet and the idea is to create one page in Word to each row in Excel. Combining my skills in VBA to Excel and what I found in the forums, I got this:

[VBA]Sub Create_Tests_Document()

Dim LV_WordApp As Object
Dim LV_RowsCounter As Integer
Dim LV_RowIndex As Integer

LV_RowsCounter = ActiveSheet.UsedRange.Rows.Count

Set LV_WordApp = CreateObject("Word.Application")
LV_WordApp.Visible = True
LV_WordApp.Documents.Open "C:\Users\douglasmmm\desktop\MyFile.docx"

For LV_RowIndex = 2 To LV_RowsCounter
LV_WordApp.Selection.GoTo What:=wdGoToPage, Name:=LV_RowIndex - 1
LV_WordApp.ActiveDocument.Bookmarks("\Page").Range.Copy
LV_WordApp.Selection.GoTo What:=wdGoToPage, Name:=LV_RowIndex - 1
LV_WordApp.Selection.Paste
With LV_WordApp.ActiveDocument.Tables(LV_RowIndex - 1)
.Cell(2, 1).Range.Text = Cells(LV_RowIndex, 2).Value
.Cell(2, 2).Range.Text = Cells(LV_RowIndex, 10).Value
End With
Next LV_RowIndex
End Sub[/VBA]

But it's not working properly because, although the code is designed to copy the last page, only the first page is copied, so I
can't update the table of the page.

What I need is:

1. Copy the Last Page;
2. Paste the Copied Page after the Last Page;
3. Edit the table of this last page with the number and the description of the scenario, according to the value of the variable LV_RowIndex in the For Each Next structure.

Can someone please help me?

Thanks a lot!

[gmayor]

Without the original document it is difficult to test, but in theory the following should work. This creates a new document based on the original document, copies the last page of that document to the end of that document and writes the values required into the tables

Sub Create_Tests_Document()
Dim LV_WordApp As Object
Dim wdDoc As Object
Dim oTable As Object
Dim oRng1 As Object
Dim oRng2 As Object
Dim oCell As Object
Dim LV_RowsCounter As Integer
Dim LV_RowIndex As Integer

    LV_RowsCounter = ActiveSheet.UsedRange.Rows.Count
    Set LV_WordApp = CreateObject("Word.Application")
    LV_WordApp.Visible = True
    Set wdDoc = LV_WordApp.Documents.Add("C:\Users\douglasmmm\desktop\MyFile.docx")
    Set oRng1 = wdDoc.Range
    oRng1.collapse 0
    oRng1.Select
    wdDoc.Bookmarks("\Page").Range.Copy
    For LV_RowIndex = 2 To LV_RowsCounter
        Set oRng2 = wdDoc.Range
        oRng2.collapse 0
        oRng2.InsertBreak 2
        Set oRng2 = wdDoc.Range
        oRng2.collapse 0
        oRng2.Paste
        Set oTable = wdDoc.tables(wdDoc.tables.Count)
        With oTable
            Set oCell = oTable.Cell(2, 1).Range
            oCell.End = oCell.End - 1
            oCell.Text = Cells(LV_RowIndex, 2).Value
            Set oCell = oTable.Cell(2, 2).Range
            oCell.End = oCell.End - 1
            oCell.Text = Cells(LV_RowIndex, 10).Value
        End With
        DoEvents
    Next LV_RowIndex
End Sub

[D_Marcel]

gmayor, I apologize for that, I'll attach the document in the next time. Your code worked perfectly for me, right in the first try!Thanks a lot for your help, I guess we left here a really useful tool to the users, including me, course, because I'm sure that I'll use it several times in the following projects or tasks that requires a lot of tests.

PS: Amazing your photo gallery.

Kind regards,

D_Marcel