Sub example2()

  Dim x As Variant

    Dim wb0 As Workbook
    Dim wl0 As Worksheet
    
Dim r1 As Range

    Application.ScreenUpdating = False
    Set wb0 = ThisWorkbook
    Set wl0 = wb0.Worksheets("Ëèñò1")

Set r1 = wl0.Range("D427:D256335")

    wb0.Activate
   With Workbooks.Open("C:\\Ó÷åò ÐÎÄÑ.xlsx")
       For Each x In r1
       'For Each x In Workbooks("Ó÷åò3.xlsm").Sheets("Ëèñò1").Cells
            If LCase(x.Text) Like "*ðîäñ*" Then
                rk = .Worksheets("Ëèñò1").Cells(Rows.Count, 3).End(xlUp).Row
                If .Worksheets("Ëèñò1").Columns(3).Find(x.Offset(, -2)) Is Nothing Then
                    .Worksheets("Ëèñò1").Cells(rk, 3).Value = x.Offset(, -2)
                    
                    .Worksheets("Ëèñò1").Cells(rk, 4).Value = x.Offset(, 2)
          
                    
                   

                End If
            End If
        Next x
End With
End Sub