将 excel 中的单元格数组复制并粘贴到单词占位符

Copy and paste array of cells from excel to word placeholder

我想使用 VBA 从 Excel 复制一组单元格并将它们复制到 word 文档中的占位符文本中。我已经编写了以下代码,但它不起作用。任何帮助都会被拒绝。到目前为止,这是我的代码:

Sub dataToWord()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wrd As New Word.Application
    
    Wrd.Visible = True
    Dim WDoc As Document
    Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".doc")  'Location of word doc.
    

    With WDoc.Content.Find ' Perform find and replace, does not work
            .Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
    End With
        

    'Save and clean up
    WDoc.Save
    WDoc.Close
    Wrd.Quit
            
End Sub
Option Explicit

Sub dataToWord()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wrd As New Word.Application
    Dim tbl As Excel.Range
    
    Wrd.Visible = True
    Dim WDoc As Document
    Dim Find1stRange As Word.Range
    Set WDoc = Wrd.Documents.Open(ThisWorkbook.Path & "\" & Range("E1").Value & ".docx")  'Location of word doc.

    ' With WDoc.Content.Find ' Perform find and replace, does not work
    ' .Execute FindText:="<Grid1>", ReplaceWith:=Range(A2:F33).Value, Replace:=wdReplaceAll
    ' End With
    
    'Define Range in Excel
    Set tbl = ThisWorkbook.Worksheets(1).Range("A2:F33")
    
    Set Find1stRange = WDoc.Range

    With Find1stRange.Find
        .Text = "<Grid1>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Find1stRange.Find.Execute
    
    'Copy Excel Table Range
    tbl.Copy

    'Paste Table into MS Word
    Find1stRange.Paragraphs(1).Range.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=False, _
        RTF:=False

    ' Autofit Table so it fits inside Word Document
    ' Dim WordTable as object
    ' Set WordTable = WDoc.Tables(1)
    ' WordTable.AutoFitBehavior (wdAutoFitWindow)

    'Save and clean up
    WDoc.Save
    WDoc.Close
    Wrd.Quit
            
End Sub