Copy cells until next cell is blank

[Ash]

Hi, I am just learning VBA code, trying to write code to copy cells in column A for a specified number of times (Specified in Range C2) until the next cell is blank.

The below code is coping range A10 three times but it copies range A14 four times. What is an error?


Sub Copy_rows1()
'
'
'
Dim j As Integer

j = Range("C2")

Range("A10").Select
ActiveCell.Copy

Do Until ActiveCell.Value < 1


For j = 1 To j

ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues

'x = Range("A10")

' Range("A10").Select
' Selection.Copy
' ActiveCell.Offset(1, 0).PasteSpecial Paste:=xlPasteValues

Next j


ActiveCell.Offset(1, 0).Select
ActiveCell.Copy


Loop


End Sub

 

[Seemanto Saha]

Hello Ash,
Thanks for sharing your problem with us. Your code for copying cells in column A for a specified number of times has some minor problems. You assigned the value of Cell C2 (specified number of times the copy operation will occur) to variable j and later used the j variable to iterate through the range where copy operation will occur. We can take a different variable i for looping through the range.

Another minor issue is that your Do Until loop will run until the Active Cell value is less than 1. This will obstruct you from copying 0 or negative values. We can modify this condition to check blank cells.

Another insignificant issue in your code is that when the code stops working the selected cell is still copied. We can turn this off by using a simple command. The modified code is given below.​

Sub Copy_rows1()

    Dim i, j As Integer

    j = Range("C2")

    Range("A10").Select
    ActiveCell.Copy

    Do Until ActiveCell.Value = ""
        For i = 1 To j
            ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues
        Next i

        ActiveCell.Offset(1, 0).Select
        ActiveCell.Copy
    Loop
    
    Application.CutCopyMode = False
End Sub

I hope this resolves your problem. Let us know your feedback.
Regards,
Seemanto Saha
Exceldemy​

 

[Ash]

Thanks a lot Saha,

It works well...