使用 Union 将多个范围复制到 Word 文档，范围之间没有空白单元格答案

【问题标题】：copy multiple ranges with Union to Word document without blank cells between the ranges使用 Union 将多个范围复制到 Word 文档，范围之间没有空白单元格
【发布时间】：2019-01-10 03:08:35
【问题描述】：

我正在尝试将多个范围复制到 Word 文档。我让它与范围的联合一起工作：

Set rng1 = Worksheets(2).Range("E2:G8")
Set rng2 = Worksheets(2).Range("E22:G23")
Set multipleRange = Union(rng1, rng2)
    multipleRange.Copy

wdApp.Selection.PasteExcelTable False, False, False
wd.Tables(1).AutoFitBehavior wdAutoFitWindow

我无法解决的问题是它会将范围之间的单元格复制为单词表中的空白单元格。它也复制了不需要的 E9:G21。
有没有办法不复制这些单元格，或者一旦它们被复制就删除它们？（这可能会破坏格式化思想）
PS：这只是第一步，稍后我想将每个工作表中相同范围的单元格复制到word文档的新页面，但我认为运行时不会有问题，只是添加了这个语境。

谢谢
硕士

【问题讨论】：

1 将范围复制到临时表。 2重新定义你的新范围3将该范围复制到Word文档4删除临时表
在下面的回答中，我以Worksheets(2) 为例。请避免使用Worksheets(2)。位置可以随时改变。使用工作表代号或实际名称。

标签： excel vba

【解决方案1】：

你可能不得不像这样一个一个地粘贴这些区域

Dim sngArea As Range

For Each sngArea In multipleRange.Areas
 sngArea.Copy
 wdApp.Selection.PasteExcelTable False, False, False
Next

【讨论】：

【解决方案2】：

除了我上面的评论，试试这个（UNTESTED）

Sub Sample()
    Dim rng1 As Range, rng2 As Range
    Dim multipleRange As Range, copyrng As Range
    Dim rngArea As Range

    Dim tmpsheet As Worksheet
    Dim ColName As String
    Dim totCols As Long, totRows As Long

    Set rng1 = Worksheets(2).Range("E2:G8")
    Set rng2 = Worksheets(2).Range("E22:G23")

    Set multipleRange = Union(rng1, rng2)

    Set tmpsheet = ThisWorkbook.Sheets.Add

    multipleRange.Copy tmpsheet.Range("A1")

    For Each rngArea In multipleRange.Areas
        If rngArea.Columns.Count > totCols Then totCols = rngArea.Columns.Count
        totRows = totRows + rngArea.Rows.Count
    Next rngArea

    ColName = Split(Cells(, totCols).Address, "$")(1)

    Set copyrng = tmpsheet.Range("A1:" & ColName & totRows)

    copyrng.Copy

    wdApp.Selection.PasteExcelTable False, False, False
    wd.Tables(1).AutoFitBehavior wdAutoFitWindow

    Application.DisplayAlerts = False
    tmpsheet.Delete
    Application.DisplayAlerts = True
End Sub

【讨论】：

【解决方案3】：

感谢您的帮助，但我自己找到了解决方案，然后再看这里：

正如 Storax 所说，您必须一一粘贴 Ranges，我用一些非常难看的代码做到了这一点，但它确实有效：

Set rng1 = Worksheets(2).Range("E2:G4")
        rng1.Copy

    wdApp.Selection.PasteExcelTable False, False, False

'------------------------------------------------------------
    Set rng2 = Worksheets(2).Range("E6:G8")
        rng2.Copy

    wdApp.Selection.PasteExcelTable False, False, False

我这样做的原因是因为我想循环浏览工作表，我认为最好的方法是将 Worksheets(2) 设置为计数器，然后循环循环。我将尝试按照 Storax 的建议只使用一种“粘贴”，但目前它可以工作。

【讨论】：