Copy each cell in a range to multi-cell range

Question

I'm trying to copy a range of cells.
I have cells D1:D10 and need to copy D1 to A1:A20, then move to D2 and copy it A21:A40, and so on.
I copied D1 to A1:A20.
How do I move down to the next cell. ("CountofResponses") is equal to 20.
Private Sub CommandButton1_Click()

Dim i As Integer
Range("D1").Select
Selection.Copy
For i = 1 To Range("CountofResponses")
    Range("A" & 1 + i).Select
    ActiveSheet.Paste
Next i

End Sub

SJR · Answer

Try this

Private Sub CommandButton1_Click()

Dim r As Range

For Each r In Range("D1:D10")
    Range("A" & 1 + (r.Row - 1) * 20).Resize(Range("CountofResponses")).Value = r.Value
Next i

End Sub

pgSystemTester · Answer

Rewriting this as I misunderstood the first part. A VBA function called OFFSET is what you're looking for. There are more efficient ways of accomplishing your overall objective that doesn't use copy/paste, but for the sake of an exact answer... here you go:
    Private Sub CommandButton1_Click()
    Dim i As Long
    For i = 1 To Range("CountofResponses").Value
        Range("D1").Offset(i-1,0).Copy Range("A" & 1 + i)
       'or you could use Range("A1").offset(i-1,0).Select
       
    Next i
    End Sub

Copy each cell in a range to multi-cell range

2 Answers

Add your own answers!

Ask a Question