Copy each Word tables from source document to target document loop page by page

Question

I have below code, which copy all tables from source document Tables.docx to target document at the end of document. All below code working without any errors.

In target document Temp.doc, I have table caption either one or two line, then one line blank and one text line starting from word refer appendix as detailed below for better clarity.

Temp.doc

---

Page 1 TABLE 1. Summary of........ (table caption)

(one line blank)

Refer Appendix 1 (one text line)

Remaining page blank, where table 1 of page 1 from source doc to be pasted or inserted.

---

Page 2 TABLE 1 contd. Summary of........ (table caption)

(one line blank)

Refer Appendix 1 (one text line)

Remaining page blank, where table 2 of page 2 from source doc to be pasted or inserted.

---

Page 3 TABLE 2. Summary of........ (table caption)

(one line blank)

Refer Appendix 2 (one text line)

Remaining page blank, where table 3 of page 3 from source doc to be pasted or inserted.

How to copy first page table from source doc to be pasted below line 3 of target doc on page 1. Similarly copy table from page 2 of source doc and paste below line 3 of page 2 of target doc and so on.

I am not having much knowledge of macro. Hence, what I tried to edit below code was not included to reduce confusion to the experts.

Sub ExtractTables()

    Dim objTable As Table
    Dim SourceDoc As Document
    Dim TargetDoc As Document
    Dim objRange As Range



    Set SourceDoc = WrdApp.Documents.Open(ActiveDocument.Path & "\Tables.docx")
    Set TargetDoc = WrdApp.Documents.Open(ActiveDocument.Path & "\Temp.doc")

    For Each objTable In SourceDoc.Tables
        objTable.Range.Select
        Selection.Copy

        Set objRange = TargetDoc.Range
        objRange.Collapse Direction:=wdCollapseEnd
        objRange.PasteSpecial DataType:=wdPasteRTF
        objRange.Collapse Direction:=wdCollapseEnd
        objRange.Text = vbCr            
    Next objTable     
End Sub

Answer 1

Your description is at best obscure. I have no idea what you might mean by

In target document Temp.doc, I have table caption either one or two line, then one line blank and one text line starting from word refer appendix

That said, if you were to insert bookmarks in your Temp.doc to indicate where these copied tables are to go, you might use code like:

Sub CopyTables()
Dim DocSrc As Document, DocTgt As Document, T As Long

Set DocSrc = WrdApp.Documents.Open(ActiveDocument.Path & "\Tables.docx")
Set DocTgt = WrdApp.Documents.Open(ActiveDocument.Path & "\Temp.doc")

With DocSrc
  For T = 1 To .Tables.Count
    If DocTgt.Bookmarks.Exists("Tbl" & T) Then
      DocTgt.Bookmarks("Tbl" & T).Range.FormattedText = .Tables(T).Range.FormattedText
    End If
  Next
End With
End Sub

The above code assumes the bookmarks in Temp.doc are named Tbl1, Tbl2, etc.

It's also not apparent why you have code like:

Dim WrdApp As Word.Application
Dim bWeStartedWord As Boolean
…

On Error Resume Next
Set WrdApp = GetObject(, "Word.Application")
On Error GoTo 0

If WrdApp Is Nothing Then
    Set WrdApp = CreateObject("Word.Application")
    bWeStartedWord = True
End If

WrdApp.Visible = True     

as there's nothing to indicate any application other than Word is involved.