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

时间:2015-07-02 17:43:47

标签: excel vba excel-vba

我在线搜索了一下,但没有发现任何与此问题完全相同的内容。我正在尝试复制多个单独的范围,并将它们粘贴到另一个工作表上的一行和另一行中。这是我到目前为止所做的。

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上收到错误。它表示无法复制多个范围。我能做些什么来实现我的目标?

2 个答案:

答案 0 :(得分:1)

您可以通过将范围放入数组,然后循环遍历数组来获得所需的内容。此外,在测试以下代码时,我必须设置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

答案 1 :(得分:0)

您无法复制包含多个区域的范围。您必须一次在一个范围内传输数据。使用Range.Areas,您可以看到您在multipleRanges中有多个区域。