简体   繁体   中英

Copy cell values from one worksheet to another

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

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM