如何复制不连续范围的联合并将其粘贴到另一个表单中？

我有一个在Excel中的表单看起来像这样：

EFGH ... NOPQ * * * * * * * * * * * * * * * * * * * * * T:* * * T:* * * * * * * * * * * * * * * * * * * * * T:* * * T:* * * * * * * * * T:* * * 

它由许多带小计的小区域组成 – 用“T”表示的行。

E栏是“价格”，“F”是数量，其余的是计算公式，或者是空的。 所以我写了一个函数来收集来自“E”的数据，这个数据最初是我想要的。

但是现在我也想从“F”和“H”获取数据，当“E”被validation时。

我的代码是：

 Private Function CollectCellsData(dataRange As Range) As Range Dim cell As Range, newRange As Range For Each cell In dataRange If Not cell.HasFormula = True And Not IsEmpty(cell.Value) Then If newRange Is Nothing Then Set newRange = cell Else Set newRange = Union(newRange, cell) End If End If Next Set CollectCellsData = newRange End Function Private Function CopyDataAndPaste(sSheet As Worksheet, sColumn As String, dSheet As Worksheet, dColumn As String) Dim lastRow As Long Dim dataRange As Range, newRange As Range lastRow = sSheet.Cells(Rows.Count, sColumn).End(xlUp).Row Set dataRange = sSheet.Range(sColumn & "3:" & sColumn & lastRow) Set newRange = CollectCellsData(dataRange) lastRow = dSheet.Cells(Rows.Count, dColumn).End(xlUp).Row If Not newRange Is Nothing Then newRange.Copy dSheet.Range(dColumn & lastRow + 1).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End If End Function 

我认为最简单的方法是简单的替代：

 Set newRange = Union(newRange, cell) 

成：

 Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3)) 

但显然我错了。 错误消息是

 "Error 1004: Command cannot be used on multiple selection" 

我认为我犯了一个概念错误。 但是，如果一个

 Union(range1, range2, range3) 

将工作。复制，为什么不在我的情况？

编辑：

我改变代码后，我的不好

 Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3)) 

在线发生错误

 newRange.Copy 

经过Chrismas007的强调，Union（）方法应该可以工作，并且msgbox rng.address提示用于debugging，现在我可以使其工作。 问题是分配“新范围”，而不是第二个，但最初的任务。 就像Gary的学生所暗示的那样，Union以统一的方式收集细胞。

 'error Set newRange = cell 'run Set newRange = Union(cell, cell.Offset(0, 1), cell.Offset(0, 3)) 

多年来一直下降的编程，现在我就像10年前的新手一样！

Answer 1

如果您复制具有多个select的范围，则无法将其粘贴到具有多个select的范围中。 因此，您必须将您的粘贴范围设置为一个单元格（即位于范围左上angular的单元格）以清除错误。

testing代码：

 Sub TestIt() Dim Rng As Range Set Rng = Union(Range("A1"), Range("B1"), Range("D1")) Rng.Copy 'This code will error: Rng.Offset(1, 0).PasteSpecial xlPasteValues 'This code will run: Range("A2").PasteSpecial xlPasteValues MsgBox Rng.Address End Sub 

Answer 2

通过Union（）构build一系列不相交的单元格并将其从一个工作簿复制到另一个工作簿将是非常好的， 但Excel不支持

假设我们对E，F，G列中填充的单元格感兴趣

但不是空的细胞。 这里我们创builddijoint范围，然后复制逐个单元格：

 Sub CopyDisjoint() Dim rBig As Range, rToCopy As Range, ady As String Dim sh1 As Worksheet, sh2 As Worksheet Dim r As Range Set sh1 = Sheets("Sheet1") Set sh2 = Sheets("Sheet2") Set rBig = sh1.Range("E:H") Set rToCopy = Intersect(rBig, sh1.Cells.SpecialCells(xlCellTypeConstants)) For Each r In rToCopy ady = r.Address r.Copy sh2.Range(ady) Next r End Sub