Copy and paste array of cells from excel to word placeholder-CodePudding

I would like to use VBA to copy an array of cells from Excel and copy them into a placeholder text in a word document. I have written the following code but it does not work. Any help would be apricated. This is my code so far:

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

CodePudding user response：

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