0
votes

I want to:

  • check cells in column E on sheet1 starting at ("E3")
  • if not empty, copy cell ("E3") to sheet2 on ("B21") and repeat with cell below them (E4, E5, ...) in sheet1 and (B22, B23, ...) sheet2, until cell on sheet1 (Ex) is empty.
  • write "complete" on sheet2 below last (Bx)

This code does not copy cell to sheet2.

Sub bla()

Set ar1 = Worksheets("sheet1").Range("E3")
Set ar2 = Worksheets("sheet2").Range("B21")

Do While Not IsEmpty(ar1)
    Range(ar1).Copy Worksheets("sheet2").Range("ar2")
    Set dr1 = ar1.Offset(1, 0)
    Set dr2 = ar2.Offset(1, 0)
    Set ar1 = dr1
    Set ar2 = dr2
Loop

ar1.Value = "Complete"
End Sub
2

2 Answers

2
votes

Try this code. It avoids loops and may be more simple to maintain/understand. End(xlDown) is the equivalent of using Ctrl + Down Arrow on keyboard against a range.

Sub bla()

    Dim ws1 as Worksheet, ws2 as Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    Dim copyRange as Range

    With ws1
        Set copyRange = .Range(.Range("E3"),.Range("E3").End(xlDown))
    End With

    With ws2.Range("B21")
        .Resize(copyRange.Rows.Count).Value = copyRange.Value
        .End(xlDown).Offset(1).Value = "Complete"
    End With

End Sub
0
votes

If i understood your code you can try this code:

I supposed that you can have the empty row in column E of the sheet1 and you don't want copy it in the sheet2... Execute the macro in the sheet1

Sub test()

Dim ws2 As Worksheet
Dim numRowSheet1, rowSheet2, i As Long

Set ws2 = Worksheets("sheet2")

rowSheet2 = 21 'start from row 21 (sheet2)

'count how many rows there are in column E
numRowSheet1 = Cells(rows.count, 5).End(xlUp).Row

With ws2
    For i = 3 To numRowSheet1
        If Cells(i, 5) <> "" Then
            'assign in cell B(sheet2) the value of the cell E of the sheet1
            .Cells(rowSheet2, 2) = Cells(i, 5)
            rowSheet2 = rowSheet2 + 1
        End If
    Next i
    .Cells(rowSheet2,2)="complete"
End With

End Sub

Hope this helps