Как я могу заставить Excel VBA проходить через определенные данные в поле, когда в конкретном столбце есть ответ? ДА

Question

Я использую Excel 2003, и я пытаюсь получить определенные данные из листа. Я хотел бы, чтобы в столбце с определенным именем было заполнено поле «да», и в случае ответа «да» он будет перетягивать всю строку данных. Вот некоторый код VBA, который я создал. У меня есть Инвентаризация рабочего листа, в которой есть все данные, и я хочу, чтобы данные перетаскивались на рабочий лист Отчетов. Любая помощь будет принята с благодарностью.

Sub AnalyseEMPHInfo()
Dim rngReports As Range
Dim rngInventory As Range
Dim StrSchemeNumber As String
Dim StrUnitName As String
Dim StrTCsSigned As String
Dim strVetSurveyCompleted As String
Dim StrBiosecurityReceived As String
Dim StrCDSurveyReceived As String
Dim strBPHSOptInOut As String

Set rngReports = Worksheets("Reports").Range("A2")
Set rngInventory = Worksheets("Inventory").Range("A2")
Do Until rngInventory = ""
    With rngInventory
        If .Offset(0, 1).Value = StrSchemeNumber And .Offset(0, 2).Value = StrUnitName _
            And .Offset(0, 3) = StrTCsSigned And .Offset(0, 4) = strVetSurveyCompleted _
            And .Offset(0, 5) = StrBiosecurityReceived _
            And .Offset(0, 6) = StrCDSurveyReceived _
            And .Offset(0, 7) = strBPHSOptInOut Then


    End With
    Set rngInventory = rngInventory.Offset(1, 0)
Loop
End Sub

Answer 1

Это перебирает все значения в столбце A, начиная с A2, и проверяет столбец D на «Да». Если он найден, он скопирует всю строку на лист отчетов

Sub AnalyseEMPHInfo()
    Dim rNext As Range
    Dim rCell As Range
    Dim rngInventory As Range

    With Worksheets("Inventory")
        Set rngInventory = .Range(.Range("A2"), .Range("A2").End(xlDown))
    End With

    For Each rCell In rngInventory.Cells
        If UCase(rCell.Offset(0, 3).Value) = "YES" Then 'check column D
            With Worksheets("Reports")
                Set rNext = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End With

            rCell.EntireRow.Copy rNext
        End If
    Next rCell

End Sub