簡體   English   中英

如何建立 VBA 宏以將范圍而不是單個單元格復制並粘貼到 MS Word 文檔?

[英]How to establish VBA macro to copy and paste a range instead of singular cells to a MS Word doc?

我在下面有一個宏,它基本上采用 excel 單元格並粘貼到 MS 字表中。 現在,每個“觀察”有 4 個 excel 單元格,必須將其復制並粘貼到具有 5 列和 2 行的 MS 字表中。 粘貼單元格(A、E、F、I)時,需要將 go 分別粘貼到表格的第 1、2、3 和 5 列中。

有誰知道是否有辦法將下面的代碼壓縮到一個簡單的范圍內? 我不想告訴宏復制這個、粘貼那個、復制這個、粘貼那個..等等,我想告訴它復制這個范圍、粘貼它,然后移動到下一個整個觀察表。


    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

你可以使用這個:例如'Obs Summary

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

您可以使用此循環遍歷范圍並將所有單元格值寫入表中:

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM