Vba: skopiuj wiersze do innego arkusza na podstawie kryteriów

Możesz użyć następującej składni w VBA, aby skopiować każdy wiersz arkusza spełniający określone kryteria do innego arkusza:

 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

To konkretne makro skopiuje każdy wiersz z arkusza Sheet1 , w którym kolumna A jest równa „Mavs”, i wklei każdy z tych wierszy do kolejnych dostępnych wierszy arkusza Sheet2 .

Poniższy przykład pokazuje, jak zastosować tę składnię w praktyce.

Przykład: Skopiuj wiersze do innego arkusza na podstawie kryteriów za pomocą VBA

Załóżmy, że w Arkuszu 1 mamy następujący zbiór danych, który zawiera informacje o różnych koszykarzach:

Załóżmy, że w Arkuszu 2 mamy następujący zestaw danych:

Należy pamiętać, że Arkusz 2 zawiera tylko dane dotyczące graczy drużyny Wojowników.

Załóżmy, że chcemy skopiować każdy wiersz z Arkusza 1 , w którym kolumna Zespół ma wartość Mavs, i wkleić każdy z tych wierszy do kolejnych dostępnych wierszy Arkusza 2 .

W tym celu możemy utworzyć następujące makro:

 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

Kiedy uruchomimy to makro, w Arkuszu 2 otrzymamy następujące dane wyjściowe:

Zauważ, że każdy wiersz w Arkuszu 1 , w którym nazwa zespołu była równa Mavs, został wklejony do kolejnych dostępnych wierszy w Arkuszu 2 .

Uwaga : Pełną dokumentację metody VBA Copy znajdziesz tutaj .

Dodatkowe zasoby

Poniższe samouczki wyjaśniają, jak wykonywać inne typowe zadania w VBA:

VBA: Jak znaleźć ostatnio używaną linię
VBA: Jak policzyć liczbę wierszy w zakresie
VBA: Jak policzyć liczbę użytych kolumn