简体   繁体   中英

Copy Multiple Ranges and Paste as one Unified Range (In a Column)

I've searched a bit online but haven't found anything exactly like this question. I am trying to copy a number of separate ranges, and paste them attached to one and other in one row on another sheet. Here is what i've done so far.

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

I am receiving an error on multipleranges.copy. It says that multiple ranges cannot be copied. What can i do to achieve my goal?

You can get what you need by putting the ranges into an array, then looping through the array. Also, when testing the below code, I had to set Transpose:=False to get it to work for me...

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

You can't copy a range with more than one area. You will have to transfer the data over one range at a time. Using Range.Areas you can see that you have multiple areas in multipleRanges.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM