在不使用书签的情况下将命名范围从 excel 复制到 word 文档中的特定位置 [更新]

Question

I wanted some help with the following problem

I have a series of ranges in excel as the example here.

table key	table range
table6	A4:G14
table7	A15:G20
table8	A21:E30

and so on.

I wanted to know if there is a code that can search a word document I have for the names in column 1 and paste the ranges in the second column. This is the segment of the code I have

    For Each cell In rng "rng is the range of the table key column"
    If cell.Value = "" Then Exit For
    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .Text = cell.Value
        .Replacement.Text = Range(cell.Offset(0, 1))
        .Execute Replace:=wdReplaceAll
    End With
Next

I get an error in the replacement.text line but I don't know how to replace it with a range.

EDIT I also tried using the code below to copy and paste the ranges in the table but I get an object defined error at the pasteexceltable line.

Set appWd = CreateObject("Word.Application")
set wdFind = appWd.Selection.Find
For Each cell In rng
    If cell.Value = "" Then Exit For
    ClipT = " "
    Range(cell.Offset(0, 1)).Copy
    wdFind.Text = cell.Value
    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd 'This function checks if the clipboard is empty'
    Range(cell.Offset(0, 1)).Copy
    ActiveWindow.Selection.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=True
    CutCopyMode = False

Answer 1

If, for example, your Word template contains the relevant tables and each is bookmarked with the same name as the table names in Excel, then, provided each Word table:

• has both a header row and an empty data row; and

• the same number of columns as your Excel data,

you could use code like:

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
      If .Bookmarks.Exists(XlTbl.Name) Then
        With .Bookmarks.Exists(XlTbl.Name)
          .Range.PasteAppendTable
          .Rows(2).Delete
        End With
      End If
    End With
  Next
End With
End Sub

The reason for the Word table initially having an empty data row is so that the paste doesn't take on the formatting of the header row.

If you really, really don't want to use bookmarks, you would need another way of correlating the Word tables and Excel data (eg via Find for an identifying string [such as the Excel table's name] in Word, or by the Word table index # [which might be retrieved from the Excel table's name]).

For example, if the Excel table's name is in the Word table's second row:

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
      With .Range.
        With .Find
          .Text = XlTbl.Name
          .MatchWildcards = True
          .Execute
        End With
        If .Find.Found = True Then
          With .Tables(1)
            .Range.PasteAppendTable
            .Rows(2).Delete
          End With
        End If
      End With
    End With
  Next
End With
End Sub

or, if the the Word table's index # corresponds with the Excel table's name:

Sub ExportToWord()
' Note: A reference to the Microsoft Word # Object Library is required,
' set via Tools|References in the Excel VBE.
Dim WdApp As New Word.Application, WdDoc As Word.Document
Dim XlSht As Excel.Worksheet, XlTbl As Excel.ListObject
Set XlSht = ThisWorkbook.Worksheets("Sheet1")
With WdApp
  Set WdDoc = .Documents.Add(Template:="full name & path to template")
  For Each XlTbl In XlSht.ListObjects
    XlTbl.DataBodyRange.Copy
    With WdDoc
        With .Tables(Replace(XlTbl.Name, "Table", ""))
          .Range.PasteAppendTable
          .Rows(2).Delete
        End With
      End If
    End With
  Next
End With
End Sub