Добавить данные к соответствующим листам на основе условия в родительском листе, используя VBA

Question

Добавить данные с одного листа к соответствующему листу, если его еще нет, на основании условия:

Я пытаюсь добавить данные в столбце A на листе «Экспорт» в столбец A на листе «проход» илидля столбца A на листе «fail» на основе значения в столбце B (либо прошел / не прошел) на листе 1.

У меня есть код для добавления данных, если он не найден, но он добавляется ко всем листам, игнорируяФильтр полностью.

Sub Test()

    Dim c As Range, f As Range
    Dim ws1, ws3

    Set ws1 = Worksheets(1)
    Set ws3 = Worksheets(3)

    For Each c In ws1.Range(ws1.Range("A1"), ws1.Cells(Rows.Count, 1).End(xlUp)).Cells

' The next line doesn't work
' If Range("B" & c).Value = "Calendar" Then

        Set f = ws3.Range(ws3.Range("A1"), _
                           ws3.Cells(Rows.Count, 1).End(xlUp)).Find( _
                                      What:=c.Value, lookat:=xlWhole)

        If f Is Nothing Then
            ws3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 3).Value = _
                                                        c.Resize(1, 3).Value
        End If
End If
    Next c

End Sub

Answer 1

Измените приведенный ниже код и попробуйте:

Option Explicit

Sub Test()

    Dim f As Range
    Dim ws1 As Worksheet, ws3 As Worksheet
    Dim c As Long '<- Change c as long NOT range

    Set ws1 = Worksheets(1) '<- Note: Here you refer to sheet with index number 1, NOT in sheet called Sheet1
    Set ws3 = Worksheets(3) '<- Note: Here you refer to sheet with index number 3, NOT in sheet called Sheet3

    For c = 1 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row '<- Loop row by row, starting from 1 to last row of columnA

        If ws1.Range("B" & c).Value = "Calendar" Then

            Set f = ws3.Range(ws3.Range("A1"), _
                               ws3.Cells(Rows.Count, 1).End(xlUp)).Find( _
                                          What:=ws1.Range("B" & c).Value, lookat:=xlWhole) '<- Change What

                If f Is Nothing Then

                    ws3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 3).Value = ws1.Range("B" & c)

                End If
        End If
    Next c

End Sub