Copy Paste Range until selected cell reached

[zachm85]

I am trying to copy down 29 lines repetitively until I reach a center cell. However I can not seem to get the lines to continue copying past the initial paste.

How do I make this loop so it will continue to the last cell desired?

Sub Copy()
Dim rng As Range

Set rng = Range("b2:b29")

For Each row In rng.Rows
For Each cell In row.Cells
rng.Select
Selection.Copy
Next cell
Range("B30:B300").Select
ActiveSheet.Paste
Next
End Sub


Thank you.

 

[Joe4]

How is the "last cell desired" determined?

 

[Joe4]

If you really mean to stop at the selected (active) cell, try this (note you can also hard-code the value).
This is set up so it can easily be adjusted for any numbers or rows in any column starting at any point:

Sub MyCopy()

    Dim myCol As String
    Dim myStartRow As Long
    Dim myJump As Long
    Dim myLastRow As Long
    Dim myEndPoint As Long
    
'   ***SET VALUES***
    myCol = "B"
    myStartRow = 2
    myJump = 28
'    myEndPoint = 100
    myEndPoint = ActiveCell.Row     'choose row of active cell for end point
    
    Application.ScreenUpdating = True
    
'   Loop
    Do
'       Find last row
        myLastRow = myStartRow + myJump - 1
'       Copy to next section if below end point, else exit
        If myStartRow + myJump < myEndPoint Then
            Range(Cells(myStartRow, myCol), Cells(myLastRow, myCol)).Copy Cells(myStartRow + myJump, myCol)
        Else
            Exit Do
        End If
'       Bump up start row
        myStartRow = myStartRow + myJump
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

 

[zachm85]

How is the "last cell desired" determined?

I had to find the last cell as i am filling to a blank cell.

 

[zachm85]

That worked

Thank yoU!

 

[Joe4]

You are welcome.