复制多个范围并粘贴为一个统一范围(在列中)

我在网上search了一下,但没有发现任何完全一样的问题。 我试图复制一些单独的范围,并将它们粘贴到另一个工作表上的一行中。 这是我迄今为止所做的。

Sub CopyTitle() Dim range1 As Range Dim range2 As Range Dim range3 As Range Dim range4 As Range Dim range5 As Range Dim range6 As Range Dim range7 As Range Dim range8 As Range Dim range9 As Range Dim range10 As Range Dim range11 As Range Dim multipleRange As Range Set range1 = Sheets("RAW").Range("B8") Set range2 = Sheets("RAW").Range("D9") Set range3 = Sheets("RAW").Range("F10") Set range4 = Sheets("RAW").Range("F12") Set range5 = Sheets("RAW").Range("F14") Set range6 = Sheets("RAW").Range("D15") Set range7 = Sheets("RAW").Range("F16") Set range8 = Sheets("RAW").Range("F18:F21") Set range9 = Sheets("RAW").Range("F23:F24") Set range10 = Sheets("RAW").Range("F26:F33") Set range11 = Sheets("RAW").Range("F35:F40") Set multipleRange = Union(range1, range2, range3, range4, range5, range6, range7, range8, range9, range10, range11) multipleRange.Copy Sheets("RAW").Cells(10, 10).PasteSpecial Transpose:=True End Sub 

我在multipleranges.copy上收到一个错误。 它说,多个范围不能被复制。 我能做些什么来实现我的目标?

您可以通过将范围放入数组中,然后在数组中循环来获得所需内容。 此外,当testing下面的代码,我不得不设置Transpose:=False让它为我工作…

 Sub CopyTitle() Dim rArray(1 To 11) As Range Set rArray(1) = Sheets("RAW").Range("B8") Set rArray(2) = Sheets("RAW").Range("D9") Set rArray(3) = Sheets("RAW").Range("F10") Set rArray(4) = Sheets("RAW").Range("F12") Set rArray(5) = Sheets("RAW").Range("F14") Set rArray(6) = Sheets("RAW").Range("D15") Set rArray(7) = Sheets("RAW").Range("F16") Set rArray(8) = Sheets("RAW").Range("F18:F21") Set rArray(9) = Sheets("RAW").Range("F23:F24") Set rArray(10) = Sheets("RAW").Range("F26:F33") Set rArray(11) = Sheets("RAW").Range("F35:F40") Dim i, j As Integer For i = 1 To 11 rArray(i).Copy j = 0 Do Until Sheets("RAW").Cells(10 + j, 10).Value = "" 'loop down until you reach the next blank cell... j = j + 1 Loop Sheets("RAW").Cells(10 + j, 10).PasteSpecial Transpose:=False Next End Sub 

您不能复制具有多个区域的范围。 您将不得不在一个范围内一次传输数据。 使用Range.Areas你可以看到你有多个区域的多个区域。