将整行从一个工作表复制到另一个

Question

我在下面发送了一些代码，但无法让它工作。

Sub mybus()
    Dim x As Long

    x = 2

    'start the loop
    Do While Cells(x, 1) <> ""
        'look for data with "bus"
        If Cells(x, 1).Value = "bus" Then
            'copy the entire row if it contains bus
            Workbooks("book1").Worksheets("Sheet1").Rows(x).Copy
            'Go to sheet 2 activate it, we want the data here
            Workbooks("book1").Worksheets("Sheet2").Activate
            'Find the first empty row in sheet2
            erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            'paste the data here
            ActiveSheet.Paste Destination:=Worksheets("sheet2").Rows(erow)
        End If
        'go to sheet1 again and activate it
        Worksheets("Sheet1").Activate
        x = x + 1

    Loop
End Sub

Answer 1

避免同时使用Range .Activate method 和Worksheet.Activate method。您只需要指定多单元格粘贴中的第一个单元格。

Sub mybus()
    Dim x As Long, erow As Long

    x = 2

    With Workbooks("book1").Worksheets("Sheet2")
        erow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    End With

    With Workbooks("book1").Worksheets("Sheet1")
        Do While Cells(x, 1) <> ""
            'look for data with "bus"
            If Cells(x, 1).Value = "bus" Then
                'copy the entire row if it contains bus to Sheet2's erow
                .Rows(x).Copy _
                   Destination:=.Parent.Worksheets("sheet2").Cells(erow, 1)
                'sequence erow to a new blank row
                erow = erow + 1
            End If
            x = x + 1
        Loop
    End With

End Sub

请参阅How to avoid using Select in Excel VBA macros，了解更多摆脱依赖选择和激活来实现目标的方法。