Question

我要：

从（“ E3”）开始检查工作表1上E列中的单元格
如果不为空，则将单元格（“ E3”）复制到（“ B21”）上的sheet2中，并在sheet1和（B22，B23，...）sheet2中位于它们下方的单元格（E4，E5，...）中重复，直到sheet1（Ex）上的单元格为空。
在工作表2的最后（Bx）下方写“完整”

此代码不会将单元格复制到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

Answer 1

尝试此代码。它避免了循环，并且可能更易于维护/理解。 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

Answer 2

如果我了解您的代码，您可以尝试以下代码：

我认为您可以在sheet1的E列中有一个空行，并且您不想将其复制到sheet2中... 执行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

希望这会有所帮助

将单元格值从一个工作表复制到另一个工作表

2 个答案: