以不同的順序將不同的動態范圍復制粘貼到新工作表中

Question

我正在嘗試以不同的順序將不同的范圍和選擇區域以特定順序復制/粘貼到新工作表中。 使用以下代碼，我試圖實現它，但不幸的是，范圍並未完全復制/粘貼到第二張紙中。 有什么建議嗎？

Sub MultipleRanges()
  Dim RngAA As Range, RngC As Range, RngR As Range, RngA As Range, RngBDEFG As Range, RngAF As Range, RngAI As Range, _
      RngAL As Range, RngAMAN As Range, RngSTUVWX As Range, RngIJKLM, UnionRng As Range
  Dim i As Long
  

' Delete all the cells from the Stock Report
  Cells(5, 1).CurrentRegion.Select
  Selection.Delete

' Copy of all the different columns from ZMM17 Unique sheet
  
  Set RngAA = Sheets("ZMM17 Unique").Range("AA7:AA" & Sheets("ZMM17 Unique").Range("AA7").End(xlDown).Row + 3)
  Set RngC = Sheets("ZMM17 Unique").Range("C7:C" & Sheets("ZMM17 Unique").Range("C7").End(xlDown).Row + 3)
  Set RngR = Sheets("ZMM17 Unique").Range("R7:R" & Sheets("ZMM17 Unique").Range("R7").End(xlDown).Row + 3)
  Set RngA = Sheets("ZMM17 Unique").Range("A7:A" & Sheets("ZMM17 Unique").Range("A7").End(xlDown).Row + 3)
  Set RngBDEFG = Sheets("ZMM17 Unique").Range("B7:G" & Sheets("ZMM17 Unique").Range("B7").End(xlDown).Row + 3)
  Set RngAF = Sheets("ZMM17 Unique").Range("AF7:AF" & Sheets("ZMM17 Unique").Range("AF7").End(xlDown).Row + 3)
  Set RngAI = Sheets("ZMM17 Unique").Range("AI7:AI" & Sheets("ZMM17 Unique").Range("AI7").End(xlDown).Row + 3)
  Set RngAL = Sheets("ZMM17 Unique").Range("AL7:AL" & Sheets("ZMM17 Unique").Range("AL7").End(xlDown).Row + 3)
  Set RngAMAN = Sheets("ZMM17 Unique").Range("AM7:AN" & Sheets("ZMM17 Unique").Range("AM7").End(xlDown).Row + 3)
  Set RngSTUVWX = Sheets("ZMM17 Unique").Range("S7:X" & Sheets("ZMM17 Unique").Range("S7").End(xlDown).Row + 3)
  Set RngIJKLM = Sheets("ZMM17 Unique").Range("I7:M" & Sheets("ZMM17 Unique").Range("I7").End(xlDown).Row + 3)
  Set UnionRng = Union(RngAA, RngC, RngR, RngA, RngBDEFG, RngAF, RngAI, RngAL, RngAMAN, RngSTUVWX, RngIJKLM)

' For debug only
  Debug.Print UnionRng.Address
  
  For i = 1 To UnionRng.Areas.Count
    ' copy current range area from Union Range
    UnionRng.Areas(i).Copy

    ' paste current range area to first column (using i variable) to "Stock Report" sheet
    Sheets("Stock Report").Range(Cells(3, i), Cells(3, i)).PasteSpecial Paste:=xlPasteValues
Next i

End Sub

Answer 1

看看這是否有效

Sub MultipleRanges()

Dim RngAA As Range, RngC As Range, RngR As Range, RngA As Range, RngBDEFG As Range, RngAF As Range, RngAI As Range, _
     RngAL As Range, RngAMAN As Range, RngSTUVWX As Range, RngIJKLM, UnionRng As Range
Dim i As Long, s(1 To 11) As String, sw As String

sw = "'ZMM17 Unique'!"

' Delete all the cells from the Stock Report
Sheets("Stock Report").Cells(5, 1).CurrentRegion.Delete

' Copy of all the different columns from ZMM17 Unique sheet
With Sheets("ZMM17 Unique")
    Set RngAA = .Range("AA7:AA" & .Range("AA7").End(xlDown).Row + 3): s(1) = sw & RngAA.Address
    Set RngC = .Range("C7:C" & .Range("C7").End(xlDown).Row + 3): s(2) = sw & RngC.Address
    Set RngR = .Range("R7:R" & .Range("R7").End(xlDown).Row + 3): s(3) = sw & RngR.Address
    Set RngA = .Range("A7:A" & .Range("A7").End(xlDown).Row + 3): s(4) = sw & RngA.Address
    Set RngBDEFG = .Range("B7:G" & .Range("B7").End(xlDown).Row + 3): s(5) = sw & RngBDEFG.Address
    Set RngAF = .Range("AF7:AF" & .Range("AF7").End(xlDown).Row + 3): s(6) = sw & RngAF.Address
    Set RngAI = .Range("AI7:AI" & .Range("AI7").End(xlDown).Row + 3): s(7) = sw & RngAI.Address
    Set RngAL = .Range("AL7:AL" & .Range("AL7").End(xlDown).Row + 3): s(8) = sw & RngAL.Address
    Set RngAMAN = .Range("AM7:AN" & .Range("AM7").End(xlDown).Row + 3): s(9) = sw & RngAMAN.Address
    Set RngSTUVWX = .Range("S7:X" & .Range("S7").End(xlDown).Row + 3): s(10) = sw & RngSTUVWX.Address
    Set RngIJKLM = .Range("I7:M" & .Range("I7").End(xlDown).Row + 3): s(11) = sw & RngIJKLM.Address
End With

For i = 1 To UBound(s)
    Range(s(i)).Copy
   ' paste current range area to first column (using i variable) to "Stock Report" sheet
   Sheets("Stock Report").Cells(3, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Paste:=xlPasteValues
Next i

Sheets("Stock Report").Columns(1).Delete Shift:=xlToLeft

End Sub