How can I duplicate a row in a Word table?

Question

I am trying to duplicate a table row in Word, using VBA, without using the Selection object or the clipboard. That is, I want a new row that has the same content as an existing row.

To do this, I first create a new (empty) row, and loop through each cell in the source row and copy its contents into the corresponding cell in the target row.

To copy each cell, I get a Range object that references the entire content of the source cell, and an equivalent Range for the target cell, and then do this:

oToRange.FormattedText = oFromRange.FormattedText

This works well on Office 2003, and also works most of the time on Office 2010. However, I am having a real problem with one particular scenario. I have (greatly) simplified that scenario to demonstrate the core of the problem.

In the picture below, there are two cells in the outer (grey) 2R x 1C table. The second row is the row to be copied. The first row is the new row I created, and into which I want to copy the content of the second row.

You'll notice that the second row contains a nested table.

When I run the code below in Word 2003, it works perfectly, and I get the following result:

But, in Word 2010, the same code produces this result:

As you can see, the cell content has been inserted before (and outside) the target table cell.

It's worth mentioning that if I put something after the nested table, so that it's no longer the last thing in the source cell, then this problem does not occur.

Here's the full VBA code I'm using:

Dim oDoc As Word.Document
Set oDoc = ThisDocument

Dim oFromRange As Range
Set oFromRange = ThisDocument.Tables(1).Cell(2, 1).Range
oFromRange.End = oFromRange.End - 1

Dim oToRange As Range
Set oToRange = ThisDocument.Tables(1).Cell(1, 1).Range
oToRange.End = oToRange.End - 1

oToRange.FormattedText = oFromRange.FormattedText

NOTE: the adjustment to the end of the source and target ranges is necessary because Cell.Range includes the end-of-cell marker, and I don't want to copy that.

What can I do to persuade it to put the content inside the target cell (like Word 2003 does), rather than before it?

Answer 1

Hope I have understood your query correctly... Isn't this what you are trying to do? This code will copy Row 1 of the table and create a copy of that row below it.

Sub Sample()
    Dim tbl As Table

    Set tbl = ActiveDocument.Tables(1)

    tbl.Rows(1).Range.Copy
    tbl.Rows(1).Select
    Selection.InsertRowsBelow
    tbl.Rows(2).Range.Paste
End Sub

Screenshot

FOLLOWUP (From Comments)

This code doesn't use the Selection object

Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(2).Range.Copy
    tbl.Rows(1).Range.Paste
End Sub

MORE FOLLOWUP (From Comments)

Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(1).Range.FormattedText = tbl.Rows(2).Range.FormattedText
    '~~~> This is required as the above code inserts a blank row in between
    tbl.Rows(2).Delete
End Sub

Answer 2

Just wanted to share what I think is the simplest solution. Doesn't use the selection object or clipboard and doesn't create an extra row that needs to be deleted.

Sub DuplicateRow(t As Table, r As Integer)
    t.Rows(r).Range.Next.InsertBefore vbCr
    t.Rows(r).Range.Next.FormattedText = t.Rows(r).Range.FormattedText
End Sub

Just call the macro with the table and the row index to duplicate. Works with any row within the table (first, last or anything in-between)

DuplicateRow ActiveDocument.Tables(1), 2

Answer 3

Function duplicate_row(ByRef ontable, rownnumber) As Row
 Dim c
 Dim fromrow As Row
 Dim newrow As Row
 Set fromrow = ontable.Rows(rownnumber)
 Set newrow = ontable.Rows.Add
 newrow.Range.FormattedText = fromrow.Range.FormattedText
 ontable.Rows(ontable.Rows.Count).Delete
 Set duplicate_row = newrow
End Function



Sub test()
 Dim newrow As Row

 Set newrow = duplicate_row(ActiveDocument.Tables(1), 2)
 newrow.Range.Find.Execute FindText:="text_service", ReplaceWith:="aaa", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_amount", ReplaceWith:="500", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_price", ReplaceWith:="50", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_comment", ReplaceWith:="bbb", Replace:=wdReplaceAll

' ActiveDocument.Tables(1).Rows(1).Delete ' after adding all rows, delete the tempalte row
End Sub