如何建立 VBA 宏以将范围而不是单个单元格复制并粘贴到 MS Word 文档？

Question

I have a macro below that essentially takes an excel cell and pastes into a MS word table. Right now, I have 4 excel cells per "observation" that have to be copied and pasted into an MS word table that has 5 columns and two rows. When pasting the cells (A, E, F, I), they need to go into column 1, 2, 3, and 5 respectively for the table.

Does anyone know if there is a way to condense the below code to a simple range? Instead of telling the macro to copy this, paste that, copy this, paste that.. etc., I would like to tell it to copy this range, paste it, then move to the next entire observation table.

    Dim tb13 As Excel.Range
    Set tb13 = ThisWorkbook.Worksheets("Observation Listing").Range("A10")
    tb13.Copy

    myDoc.Tables(4).Cell(Row:=2, Column:=1).Range.PasteExcelTable _
    LinkedToExcel:=True, _
    WordFormatting:=False, _
    RTF:=True
    
'Obs Summary
    Dim tb14 As Excel.Range
    Set tb14 = ThisWorkbook.Worksheets("Observation Listing").Range("E11")
    tb14.Copy

    myDoc.Tables(4).Cell(Row:=2, Column:=2).Range.PasteExcelTable _
    LinkedToExcel:=True, _
    WordFormatting:=False, _
    RTF:=True
    
'Pot. Bus. Impact
    Dim tb15 As Excel.Range
    Set tb15 = ThisWorkbook.Worksheets("Observation Listing").Range("F11")
    tb15.Copy

    myDoc.Tables(4).Cell(Row:=2, Column:=3).Range.PasteExcelTable _
    LinkedToExcel:=True, _
    WordFormatting:=False, _
    RTF:=True
    
'Action Plan
    Dim tb16 As Excel.Range
    Set tb16 = ThisWorkbook.Worksheets("Observation Listing").Range("I11")
    tb16.Copy

    myDoc.Tables(4).Cell(Row:=2, Column:=5).Range.PasteExcelTable _
    LinkedToExcel:=True, _
    WordFormatting:=False, _
    RTF:=True

Answer 1

You can use this: for expample by 'Obs Summary

myDoc.Tables(4).Cell(2, 2).Range.text = _ 
        ThisWorkbook.Worksheets("Observation Listing").Range("E11").value

You can use this cycle to loop through the range and write all cell values into the table:

Dim rng As Range
Dim v As Variant
Dim col As Long, r As Long
Set rng = ThisWorkbook.Worksheets("ObservationListing").Range("A11:C11")
col = 1 'start with this column
r = 2 ' row
For Each v In rng.Cells
    myDoc.Tables(4).Cell(r, col).Range.Text = v.Value
    col = col + 1
Next v