Use Word Macro/VBA to Copy Tables from One Word Document to Another Word Document

Question

I am new to VBA and I would like seek help to create a Word macro to copy certain content tables from Microsoft Office 365 Word Document A to Microsoft Office 365 Word Document B.

1. Document A has at least 1 content table, but it can have up to, for example, 20 content tables. In order words, the upper bound is dynamic.

1.1 Each content table has two rows and four columns:

1.1.1 the first row has four column cells,

1.1.2 the second row has the first and second column cells merged into one cell, and thus the second row has three columns.

2. Document B is a blank template. It has some pre-defined text content and then followed by 20 blank content tables. The content table structure in Document B is the same as that in Document A.

3. The macro needs to do the following:

3.1 Copy the content tables from Document A to Document B in the same sequential order.

3.2 For each content table in Document A, copy as below:

3.2.1 Copy the first row as is to the first row of the corresponding content table in Document B.

3.2.2 Copy the second row as below:

3.2.2.1 Copy the second row's first column/cell in Document A to the second row's first column/cell in Document B.

3.2.2.2 Copy the second row's third column/cell in Document A to the second row's second column/cell in Document B. That's all.

I tried to record a macro to do the above but it did not work.

Please kindly advise and help.

Answer 1

Your Document B, which you (probably erroneously) call a template is not blank - it has content. As for the table replication, try:

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, t As Long
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the source file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocSrc = Documents.Open(.SelectedItems(1), ReadOnly:=True, AddToRecentFiles:=False)
  Else
    MsgBox "No source file selected. Exiting", vbExclamation
    GoTo ErrExit
  End If
End With
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select the target file"
  .AllowMultiSelect = False
  If .Show = -1 Then
    Set DocTgt = Documents.Open(.SelectedItems(1), ReadOnly:=False, AddToRecentFiles:=False)
  Else
    MsgBox "No target file selected. Exiting", vbExclamation
    DocSrc.Close SaveChanges:=False
    GoTo ErrExit
  End If
End With
With DocSrc
  For t = 1 To .Tables.Count
    DocTgt.Tables(t).Range.FormattedText = .Tables(t).Range.FormattedText
    DocTgt.Tables(t).Cell(2, 3).Range.Text = vbNullString
    DocTgt.Tables(t).Cell(2, 4).Range.Text = vbNullString
  Next
  .Close False
End With
DocTgt.Activate
ErrExit:
Set DocSrc = Nothing: Set DocTgt = Nothing
Application.ScreenUpdating = True
End Sub