Vba: скопировать строки на другой лист на основе критериев

Вы можете использовать следующий синтаксис в VBA для копирования каждой строки листа, соответствующей определенным критериям, на другой лист:

 Sub CopyToAnotherSheet()

   Dim LastRow As Long

  'Find last used row in a Column A of Sheet1
   With Worksheets(" Sheet1 ")
      LastRow = .Cells(.Rows.Count, " A ").End(xlUp).Row
   End With

   'Find first row where values should be posted in Sheet2
   With Worksheets(" Sheet2 ")
      j = .Cells(.Rows.Count, " A ").End(xlUp).Row + 1
   End With
   
   'Paste each row that contains "Mavs" in column A of Sheet1 into Sheet2
   For i = 1 TB LastRow
       With Worksheets(" Sheet1 ")
           If .Cells(i, 1).Value = "Mavs" Then
               .Rows(i).Copy Destination:=Worksheets(" Sheet2 ").Range(" A " & j)
               j = j + 1
           End If
       End With
   Next i
   
End Sub

Этот конкретный макрос скопирует каждую строку Sheet1 , где столбец A равен «Mavs», и вставит каждую из этих строк в следующие доступные строки Sheet2 .

В следующем примере показано, как использовать этот синтаксис на практике.

Пример. Копирование строк на другой лист на основе критериев с помощью VBA.

Предположим, у нас есть следующий набор данных на листе 1 , который содержит информацию о различных баскетболистах:

Предположим, у нас есть следующий набор данных в Sheet2 :

Обратите внимание, что Лист 2 содержит данные только об игроках команды Warriors.

Допустим, мы хотим скопировать каждую строку из Sheet1 , где столбец Team равен Mavs, и вставить каждую из этих строк в следующие доступные строки Sheet2 .

Для этого мы можем создать следующий макрос:

 Sub CopyToAnotherSheet()

   Dim LastRow As Long

  'Find last used row in a Column A of Sheet1
   With Worksheets(" Sheet1 ")
      LastRow = .Cells(.Rows.Count, " A ").End(xlUp).Row
   End With

   'Find first row where values should be posted in Sheet2
   With Worksheets(" Sheet2 ")
      j = .Cells(.Rows.Count, " A ").End(xlUp).Row + 1
   End With
   
   'Paste each row that contains "Mavs" in column A of Sheet1 into Sheet2
   For i = 1 TB LastRow
       With Worksheets(" Sheet1 ")
           If .Cells(i, 1).Value = "Mavs" Then
               .Rows(i).Copy Destination:=Worksheets(" Sheet2 ").Range(" A " & j)
               j = j + 1
           End If
       End With
   Next i
   
End Sub

Когда мы запускаем этот макрос, мы получаем следующий вывод в Sheet2 :

Обратите внимание, что каждая строка в Sheet1 , где имя команды равно Mavs, была вставлена в следующие доступные строки в Sheet2 .

Примечание . Полную документацию по методу копирования VBA можно найти здесь .

Дополнительные ресурсы

В следующих руководствах объясняется, как выполнять другие распространенные задачи в VBA:

VBA: как найти последнюю использованную строку
VBA: как подсчитать количество строк в диапазоне
VBA: как подсчитать количество используемых столбцов