Select non-contiguous cells and paste to specific columns on next blank row

Question

I need to select non-contiguous cells in a sheet and paste them to specific columns on the next blank row of another sheet. The code below can copy non-contiguous cells and paste to specific cells on the required sheet, but I cannot adapt to get it to copy to the next blank row.

Sub Copycell()

    Dim rng1 As Range
    Set rng1 = Range("B2,B4,B6")

    Dim rng2 As Range
    Set rng2 = Sheets("list").Range("A2,B2,D2")

    Dim i As Long
    For Each cel In rng2
        cel.Value = rng1.Cells(i + 1)
        i = i + 1
        Next

End Sub

I'm not sure I understand what you're trying to do. Is it correct that you wish only to copy cell B2, B4 and B6 and then paste them to the next blank cells in column A, B and D on the worksheet "list"? — DirtyDeffy

Harassed Dad Harassed Dad · Accepted Answer · 2018-05-15T12:53:31

Sub Copycell()
    Dim Lastrow as long
    lastrow =  Sheets("list").Cells(sheets("list").rows.count,1).End(xlup).row
    Dim rng1 As Range
    Set rng1 = Range("B2,B4,B6")

    Dim rng2 As Range
    Set rng2 = Sheets("list").Range("A" & lastrow & ",B" & lastrow & ",D" & lastrow)

    Dim i As Long
    For Each cel In rng2
        cel.Value = rng1.Cells(i + 1)
        i = i + 1
        Next

End Sub

Select non-contiguous cells and paste to specific columns on next blank row

1 Answers