Скопируйте целую строку из 1 листа в другую

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 для более методов на получение от полагаться на выбор и активировать для достижения ваших целей.