Copy table from Word and paste into another Word document - vba

Question

I'm trying to open a Word Document and copy the whole table inside it and then paste it into another already-open document after a specific heading/bookmark (that I have bookmarked in the document). Then finally prompt the user to save the document with the newly pasted table.
Examples seen online are Excel-to-Word or Word-to-Excel; I need Word-to-Word.
I'm able to pull up the first document (I think it successfully copies it, too--I haven't tested it), but when it activates the second document, it stops and gives an error that it doesn't have an object assigned.
The debugger highlights Set WrdRng = Active.Bookmarks("AppendixA").Range.
Sub TEST()
'
' Declare Table Document Var as Object
Dim tb As Object
Dim bk As Bookmark
Dim WrdRng As Range
'
'
'Set up Word Application
Set tb = CreateObject("Word.Application")
tb.Visible = True
'Opens Pre-Saved Document & activates it to use
tb.Documents.Open "C:\ Desktop\Table.dotm"
tb.Activate
Selection.WholeStory
'ActiveDocument.Tables(1).Select
Selection.Font.Name = "Calibri"
Selection.Copy
'Activate Rolling Trend Report Document and Paste
Windows("TEST - Compatibility Mode").Activate
' where the error occurs and the debugger highlights
Set WrdRng = Active.Bookmarks("AppendixA").Range
'Paste to Bookmark
With WrdRng
Selection.InsertAfter
End With
'Save Completed Report to Desktop
ChangeFileOpenDirectory "C: \Desktop\"
ActiveDocument.SaveAs2 FileName:="TEST.docm", _
FileFormat:=wdFormatXMLDocumentMacroEnabled
'
'
'
End Sub

Answer 1

Your code is failing because Set WrdRng = Active.Bookmarks("AppendixA").Range should be Set WrdRng = ActiveDocument.Bookmarks("AppendixA").Range
However, your code is badly written, will also fail in other places and will create an extra instance of Word.
The code below is to run from Word
Sub TEST()
'store a pointer to the document you wnat to insert table into
'assumed to be currently active document
Dim targetDoc As Document
Set targetDoc = ActiveDocument
'Open Pre-Saved Document
Dim tblDoc As Document
Set tblDoc = Documents.Open("C:\ Desktop\Table.dotm")
Dim source As Range
Set source = tblDoc.Content
'exclude the paragraph that comes after the table
source.MoveEnd Unit:=wdCharacter, Count:=-1
source.Font.Name = "Calibri"
Dim appxA As Range
Set appxA = targetDoc.Bookmarks("AppendixA").Range
appxA.Collapse wdCollapseEnd
'transfer the text and close the source document
appxA.FormattedText = source.FormattedText
tblDoc.Close wdDoNotSaveChanges
'it is necessary to pass the full file path to the SaveAs command
ActiveDocument.SaveAs2 FileName:="C: \Desktop\TEST.docm", _
FileFormat:=wdFormatXMLDocumentMacroEnabled
End Sub