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

时间:2018-08-02 11:02:46

标签: excel excel-vba

我正在尝试将多个范围复制到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文档的新页面,但是我认为运行此方法不会有问题,只需将其添加为上下文。

谢谢
硕士

3 个答案:

答案 0 :(得分:0)

您可能必须像这样一个接一个地粘贴区域

Dim sngArea As Range

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

答案 1 :(得分:0)

在上面我的评论中,请尝试以下(未测试

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

答案 2 :(得分:0)

谢谢您的帮助,但是在再次查看这里之前,我自己找到了解决方案:

就像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建议的一种“粘贴”功能,但目前它可以使用。