Копировать значения ячеек из одного листа в другой

Question

Я хочу:

• проверить ячейки в столбце E на листе 1, начиная с ("E3")
• если не пусто, скопируйте ячейку ("E3") в sheet2 on ("B21") и повторите с ячейкой под ними (E4, E5, ...) в sheet1 и (B22, B23, ...) sheet2 , пока ячейка на листе 1 (Ex) не станет пустой.
• напишите "завершено" на листе 2 ниже последнего (Bx)

Этот код не копирует ячейку на лист 2.

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

Answer 1

Если я понял ваш код, вы можете попробовать этот код:

Я предположил, что у вас может быть пустая строка в столбце E листа sheet1, и вы не хотите копировать его в sheet2 ... Выполнить макрос в листе1

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

Надеюсь, это поможет

Answer 2

Попробуйте этот код. Это позволяет избежать циклов и может быть более простым в обслуживании / понимании. End(xlDown) эквивалентно использованию Ctrl + Down Arrow на клавиатуре для диапазона.

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