Это мой подход к ее решению.
Пожалуйста, прочитайте комментарии к коду и настройте его в соответствии со своими потребностями.
Public Sub CopyData()
' Define the object variables
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
' Define other variables
Dim searchString As String
Dim lastSourceRow As Long
Dim startSourceRow As Long
Dim lastTargetRow As Long
Dim sourceRowCounter As Long
Dim columnToEval As Long
Dim columnCounter As Long
Dim columnsToCopy As Variant
' Adjust the worksheets names
Set sourceWorksheet = ThisWorkbook.Worksheets("Circuit Data")
Set targetWorksheet = ThisWorkbook.Worksheets("Lockout-Est. Cost of Care")
' Define the number of columns to copy from one sheet to the other
columnsToCopy = Array(1, 5, 21, 27, 29, 231)
' Set the string you're going to evaluate
searchString = "Lockout"
' Adjust the initial row where data is going to be evaluated
startSourceRow = 8
' Adjust the column where you evaluate if condition is met
columnToEval = 29
' Find the number of the last row in source sheet (notice that this search in column A = 1)
lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
For sourceRowCounter = startSourceRow To lastSourceRow
' Evaluate if criteria is met in column 29
If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchString Then
' Get last row on target sheet (notice that this search in column A = 1)
lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
For columnCounter = 0 To UBound(columnsToCopy)
' You don't need to use copy and paste if values is all that you're passing
targetWorksheet.Cells(lastTargetRow, columnsToCopy(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value
Next columnCounter
End If
Next sourceRowCounter
' If this is necessary...
sourceWorksheet.Activate
End Sub
РЕДАКТИРОВАТЬ:
Добавлено:
- Поиск нескольких строк
- Определить другие столбцы в targetWorksheet, чем sourceWorksheet
Новый код (с комментариями):
Option Explicit
Public Sub CopyData()
' Define the object variables
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
' Define other variables
Dim searchStrings() As String ' -> Updated to hold multiple values
Dim lastSourceRow As Long
Dim startSourceRow As Long
Dim lastTargetRow As Long
Dim sourceRowCounter As Long
Dim columnToEval As Long
Dim columnCounter As Long
Dim searchCounter As Long ' -> New
Dim columnsToCopy As Variant
Dim columnsDestination As Variant
' Adjust the worksheets names
Set sourceWorksheet = ThisWorkbook.Worksheets("Circuit Data")
Set targetWorksheet = ThisWorkbook.Worksheets("Lockout-Est. Cost of Care")
' Define the number of columns to copy from one sheet to the other
columnsToCopy = Array(1, 5, 21, 27, 29, 231)
columnsDestination = Array(1, 2, 3, 4, 5, 6) ' -> This must have the same items' quantity as columnsToCopy
' Set the string you're going to evaluate
searchStrings = Split("Lockout,DJJ lockout", ",") ' -> Here the values are separated by commas in one single string (be careful of spaces between commas)
' Adjust the initial row where data is going to be evaluated
startSourceRow = 8
' Adjust the column where you evaluate if condition is met
columnToEval = 29
' Find the number of the last row in source sheet (notice that this search in column A = 1)
lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row
For sourceRowCounter = startSourceRow To lastSourceRow
' New -> Where need to iterate through each of the values in the search string array
For searchCounter = 0 To UBound(searchStrings)
' Evaluate if criteria is met in column 29
If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchStrings(searchCounter) Then
' Get last row on target sheet (notice that this search in column A = 1)
lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row
For columnCounter = 0 To UBound(columnsToCopy)
' You don't need to use copy and paste if values is all that you're passing
' -> New See that I replaces the first columnsToCopy for columnsDestination
targetWorksheet.Cells(lastTargetRow, columnsDestination(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value
Next columnCounter
End If
Next searchCounter
Next sourceRowCounter
' If this is necessary...
sourceWorksheet.Activate
End Sub