新しいシートにさまざまなダイナミックレンジを異なる順序で貼り付けます

Question

異なる順序で異なる範囲と選択領域をコピーして、新しい順序で特定の順序で貼り付けます。 次のコードでは、これを達成しようとしましたが、残念ながら範囲は2番目のシートに完全にコピー/貼り付けされていません。どんな勧告？

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 collumns 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 collumns 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