我正在尝试将多个范围复制到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文档的新页面,但是我认为运行此方法不会有问题,只需将其添加为上下文。
谢谢
硕士
答案 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建议的一种“粘贴”功能,但目前它可以使用。