как отобразить смежные ячейки подряд

Question

Я получил 5 заголовков таблицы в A1:E1.Я хочу отобразить данные смежных ячеек (A2, B4, D5, E1, F3) в ячейках A2:E2.Пожалуйста, помогите сделать это.Мой код отображается ниже

Sub test()
    Dim copyRange As Range, cel As Range, pasteRange As Range, 
        erow As Long, ecolumn As Long
    Set copyRange = ThisWorkbook.Sheets("Sheet1").Range("A2, B4, D5, E1, F3")
    Set pasteRange = ThisWorkbook.Sheets("Sheet2").Range("A2")
    For Each cel In copyRange
            cel.Copy
            erow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 1).Row
            erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(0, 1).Row
            ecolumn = Sheet2.Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Row
            pasteRange.Cells(1, ecolumn).PasteSpecial xlPasteValues
    Next
    Application.CutCopyMode = False
End Sub

Answer 1

Более простой подход:

Sub test()
    Dim cel As Range, pasteRange As Range

    Set pasteRange = ThisWorkbook.Sheets("Sheet2").Range("A2")
    For Each cel In ThisWorkbook.Sheets("Sheet1").Range("A2, B4, D5, E1, F3")
            pasteRange.Value = cel.Value
            Set pasteRange = pasteRange.Offset(0, 1)
    Next

End Sub

Answer 2

@ TimWilliams ответ быстрый и простой, но я просто подумал показать вам, как это сделать с массивом:

Sub t2()
Dim copyRange As Range, cel As Range, pasteRange As Range
Set copyRange = ThisWorkbook.Sheets("Sheet1").Range("A2, B4, D5, E1, F3")
Set pasteRange = ThisWorkbook.Sheets("Sheet2").Range("A2")

Dim copyVals() As Variant
ReDim copyVals(0 To copyRange.Cells.Count)

Dim n As Long
n = 0
For Each cel In copyRange
    copyVals(n) = cel.Value
    n = n + 1
Next cel

Dim k As Long
For k = LBound(copyVals) To UBound(copyVals)
    pasteRange.Offset(k, 0).Value = copyVals(k)
Next k
End Sub