Attribute VB_Name = "Module3"
Sub compare5()

 Dim k As Integer
    k =  1 

Set Target = ThisWorkbook.Sheets( 1 ).UsedRange.Columns( 6 ).Cells

For Each cc In Target 'цикл по используемым ячейкам втрой колонки
a = cc.Rows.Row 'номер ряда анализируемй ячейки
flag =  0  'флаг совпадения

Set x = ThisWorkbook.Sheets( 2 ).Columns( 6 ).Find(ThisWorkbook.Sheets( 1 ).Cells(a,  6 ), _
    LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'поиск полного совпадения _
    по  6 -ой колонке значения из  6 -ой колонки  2 -го листа
    
If x Is Nothing Then ' если не нашли, уходим на след.поиск
GoTo goout
Else
    iFirstAddress = x.Address 'запоминаем адрес первого совпадения
    
    ThisWorkbook.Sheets( 1 ).Activate
            If ThisWorkbook.Sheets( 1 ).Cells(a,  6 ).Value = ThisWorkbook.Sheets( 2 ).Cells(x.Rows.Row,  6 ).Value Then
            flag =  1  'если пара совпадает, ставим пометку
     '       MsgBox (Cells(a, 6).Value)
            
           ' Set nach01 = Cells(a, 8).Value
           ' Set nach02 = Cells(x.Rows.Row, 8).Value
             ThisWorkbook.Sheets( 1 ).Activate
            Dim x1 As Range
    Set x1 = Worksheets("Лист1").Range(Cells(a,  8 ), Cells(a,  100 )).Find( 1 , LookAt:=xlWhole)
    If Not x1 Is Nothing Then nc1 = x1.Next.Value
     Dim x2 As Range
    Set x2 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 2 , LookAt:=xlWhole)
    If Not x2 Is Nothing Then nc2 = x2.Next.Value
     Dim x3 As Range
    Set x3 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 3 , LookAt:=xlWhole)
    If Not x3 Is Nothing Then nc3 = x3.Next.Value
     Dim x4 As Range
    Set x4 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 4 , LookAt:=xlWhole)
    If Not x4 Is Nothing Then nc4 = x4.Next.Value
     Dim x5 As Range
    Set x5 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 5 , LookAt:=xlWhole)
    If Not x5 Is Nothing Then nc5 = x5.Next.Value
     Dim x6 As Range
    Set x6 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 6 , LookAt:=xlWhole)
    If Not x6 Is Nothing Then nc6 = x6.Next.Value
     Dim x7 As Range
    Set x7 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 7 , LookAt:=xlWhole)
    If Not x7 Is Nothing Then nc7 = x7.Next.Value
     Dim x8 As Range
    Set x8 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 8 , LookAt:=xlWhole)
    If Not x8 Is Nothing Then nc8 = x8.Next.Value
     Dim x9 As Range
    Set x9 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 9 , LookAt:=xlWhole)
    If Not x9 Is Nothing Then nc9 = x9.Next.Value
      Dim x10 As Range
    Set x10 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 10 , LookAt:=xlWhole)
    If Not x10 Is Nothing Then nc10 = x10.Next.Value
     Dim x11 As Range
    Set x11 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 11 , LookAt:=xlWhole)
    If Not x11 Is Nothing Then nc11 = x11.Next.Value
     Dim x12 As Range
    Set x12 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 12 , LookAt:=xlWhole)
    If Not x12 Is Nothing Then nc12 = x12.Next.Value
    
    ThisWorkbook.Sheets( 2 ).Activate
      
      Dim y1 As Range
    Set y1 = Worksheets("Лист2").Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 1 , LookAt:=xlWhole)
    If Not y1 Is Nothing Then ns1 = y1.Next.Value
        Dim y2 As Range
    Set y2 = Worksheets("Лист2").Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 2 , LookAt:=xlWhole)
    If Not y2 Is Nothing Then ns2 = y2.Next.Value
    Dim y3 As Range
    Set y3 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 3 , LookAt:=xlWhole)
    If Not y3 Is Nothing Then ns3 = y3.Next.Value
    Dim y4 As Range
    Set y4 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 4 , LookAt:=xlWhole)
    If Not y4 Is Nothing Then ns4 = y4.Next.Value
    Dim y5 As Range
    Set y5 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 5 , LookAt:=xlWhole)
    If Not y5 Is Nothing Then ns5 = y5.Next.Value
    Dim y6 As Range
    Set y6 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 6 , LookAt:=xlWhole)
    If Not y6 Is Nothing Then ns6 = y6.Next.Value
    Dim y7 As Range
    Set y7 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 7 , LookAt:=xlWhole)
    If Not y7 Is Nothing Then ns7 = y7.Next.Value
    Dim y8 As Range
    Set y8 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 8 , LookAt:=xlWhole)
    If Not y8 Is Nothing Then ns8 = y8.Next.Value
    Dim y9 As Range
    Set y9 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 9 , LookAt:=xlWhole)
    If Not y9 Is Nothing Then ns9 = y9.Next.Value
    Dim y10 As Range
    Set y10 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 10 , LookAt:=xlWhole)
    If Not y10 Is Nothing Then ns10 = y10.Next.Value
    Dim y11 As Range
    Set y11 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 11 , LookAt:=xlWhole)
    If Not y11 Is Nothing Then ns11 = y11.Next.Value
    Dim y12 As Range
    Set y12 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 12 , LookAt:=xlWhole)
    If Not y12 Is Nothing Then ns12 = y12.Next.Value
    
   ThisWorkbook.Sheets( 3 ).Activate
    
    If nc1 = ns1 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "1"
.Range("I" & CStr(k)).Value = nc1
End With
k = k +  1 
End If

    If nc2 = ns2 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "2"
.Range("I" & CStr(k)).Value = nc2
End With
k = k +  1 
End If
                
                   If nc3 = ns3 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "3"
.Range("I" & CStr(k)).Value = nc3
End With
k = k +  1 
End If
                
 If nc4 = ns4 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "4"
.Range("I" & CStr(k)).Value = nc4
End With
k = k +  1 
End If

                    
 If nc5 = ns5 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "5"
.Range("I" & CStr(k)).Value = nc5
End With
k = k +  1 
End If

If nc6 = ns6 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "6"
.Range("I" & CStr(k)).Value = nc6
End With
k = k +  1 
End If
 

If nc7 = ns7 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "7"
.Range("I" & CStr(k)).Value = nc7
End With
k = k +  1 
End If

 If nc8 = ns8 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "8"
.Range("I" & CStr(k)).Value = nc8
End With
k = k +  1 
End If

 If nc9 = ns9 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "9"
.Range("I" & CStr(k)).Value = nc9
End With
k = k +  1 
End If

If nc10 = ns10 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "10"
.Range("I" & CStr(k)).Value = nc10
End With
k = k +  1 
End If

If nc11 = ns1 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "11"
.Range("I" & CStr(k)).Value = nc11
End With
k = k +  1 
End If

If nc12 = ns6 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "12"
.Range("I" & CStr(k)).Value = nc12
End With
k = k +  1 
End If

 
            GoTo goout  ' уходим на след.поиск
            
            
    Do
    ' запускаемся на поиск след.совпадений
    Set x = ThisWorkbook.Sheets( 1 ).Columns( 6 ).FindNext(x)
    iSecondAddress = x.Address 'запоминаем адрес следующего совпадения
    
        If ThisWorkbook.Sheets( 1 ).Cells(a,  6 ).Value = ThisWorkbook.Sheets( 2 ).Cells(x.Rows.Row,  6 ).Value Then
        flag =  1 
        'Set nach01 = Cells(a, 8).Value
        'Set nach02 = Cells(x.Rows.Row, 8).Value
        
                 Dim z1 As Range
    Set z1 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 1 , LookAt:=xlWhole)
    If Not z1 Is Nothing Then nc1 = x1.Next.Value
     Dim z2 As Range
    Set z2 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 2 , LookAt:=xlWhole)
    If Not z2 Is Nothing Then nc2 = x2.Next.Value
     Dim z3 As Range
    Set z3 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 3 , LookAt:=xlWhole)
    If Not z3 Is Nothing Then nc3 = x3.Next.Value
    
     Dim z4 As Range
    Set z4 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 4 , LookAt:=xlWhole)
    If Not z4 Is Nothing Then nc4 = x4.Next.Value
     Dim z5 As Range
    Set z5 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 5 , LookAt:=xlWhole)
    If Not z5 Is Nothing Then nc5 = x5.Next.Value
     Dim z6 As Range
    Set z6 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 6 , LookAt:=xlWhole)
    If Not z6 Is Nothing Then nc6 = x6.Next.Value
     Dim z7 As Range
    Set z7 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 7 , LookAt:=xlWhole)
    If Not z7 Is Nothing Then nc7 = x7.Next.Value
     Dim z8 As Range
    Set z8 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 8 , LookAt:=xlWhole)
    If Not z8 Is Nothing Then nc8 = x8.Next.Value
     Dim z9 As Range
    Set z9 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 9 , LookAt:=xlWhole)
    If Not z9 Is Nothing Then nc9 = x9.Next.Value
      Dim z10 As Range
    Set z10 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 10 , LookAt:=xlWhole)
    If Not z10 Is Nothing Then nc10 = x10.Next.Value
     Dim z11 As Range
    Set z11 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 11 , LookAt:=xlWhole)
    If Not z11 Is Nothing Then nc11 = x11.Next.Value
     Dim z12 As Range
    Set z12 = ThisWorkbook.Sheets( 1 ).Range(Cells(a,  8 ), Cells(a,  100 )).Find( 12 , LookAt:=xlWhole)
    If Not x12 Is Nothing Then nc12 = x12.Next.Value
    
     Dim v1 As Range
    Set v1 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 1 , LookAt:=xlWhole)
    If Not v1 Is Nothing Then ns1 = y1.Next.Value
        Dim v2 As Range
    Set v2 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 2 , LookAt:=xlWhole)
    If Not v2 Is Nothing Then ns2 = y2.Next.Value
    Dim v3 As Range
    Set v3 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 3 , LookAt:=xlWhole)
    If Not v3 Is Nothing Then ns3 = y3.Next.Value
    Dim v4 As Range
    Set v4 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 4 , LookAt:=xlWhole)
    If Not v4 Is Nothing Then ns4 = y4.Next.Value
    Dim v5 As Range
    Set v5 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 5 , LookAt:=xlWhole)
    If Not v5 Is Nothing Then ns5 = y5.Next.Value
    Dim v6 As Range
    Set v6 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 6 , LookAt:=xlWhole)
    If Not v6 Is Nothing Then ns1 = y6.Next.Value
    Dim v7 As Range
    Set v7 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 7 , LookAt:=xlWhole)
    If Not v7 Is Nothing Then ns7 = y7.Next.Value
    Dim v8 As Range
    Set v8 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 8 , LookAt:=xlWhole)
    If Not v8 Is Nothing Then ns8 = y8.Next.Value
    Dim v9 As Range
    Set v9 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 9 , LookAt:=xlWhole)
    If Not v9 Is Nothing Then ns9 = y9.Next.Value
    Dim v10 As Range
    Set v10 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 10 , LookAt:=xlWhole)
    If Not v10 Is Nothing Then ns1 = y10.Next.Value
    Dim v11 As Range
    Set v11 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 11 , LookAt:=xlWhole)
    If Not v11 Is Nothing Then ns11 = y11.Next.Value
    Dim v12 As Range
    Set v12 = ThisWorkbook.Sheets( 2 ).Range(Cells(x.Rows.Row,  8 ), Cells(a,  100 )).Find( 12 , LookAt:=xlWhole)
    If Not v12 Is Nothing Then ns12 = y12.Next.Value
    
    
    
   If nc1 = ns1 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "1"
.Range("I" & CStr(k)).Value = nc1
End With
k = k +  1 
End If
 
   
    If nc2 = ns2 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "2"
.Range("I" & CStr(k)).Value = nc2
End With
k = k +  1 
End If

   If nc3 = ns3 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "3"
.Range("I" & CStr(k)).Value = nc3
End With
k = k +  1 
End If

   If nc4 = ns4 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "4"
.Range("I" & CStr(k)).Value = nc4
End With
k = k +  1 
End If

                    
 
 If nc5 = ns5 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "5"
.Range("I" & CStr(k)).Value = nc5
End With
k = k +  1 
End If
                    
                    
If nc6 = ns6 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "6"
.Range("I" & CStr(k)).Value = nc6
End With
k = k +  1 
End If

If nc7 = ns7 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "7"
.Range("I" & CStr(k)).Value = nc7
End With
k = k +  1 
End If

 If nc8 = ns8 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "8"
.Range("I" & CStr(k)).Value = nc8
End With
k = k +  1 
End If
                   
 If nc9 = ns9 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "9"
.Range("I" & CStr(k)).Value = nc9
End With
k = k +  1 
End If

If nc10 = ns10 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "10"
.Range("I" & CStr(k)).Value = nc10
End With
k = k +  1 
End If
 
If nc11 = ns11 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "11"
.Range("I" & CStr(k)).Value = nc11
End With
k = k +  1 
End If

If nc12 = ns12 Then
With ThisWorkbook.Sheets( 3 )
.Cells( 1 , k).Resize(,  7 ).Value = ThisWorkbook.Sheets( 1 ).Cells(a,  1 ).Resize(,  7 ).Value
.Range("H" & CStr(k)).Value = "12"
.Range("I" & CStr(k)).Value = nc12
End With
k = k +  1 
End If

        
        'если пара совпадает, ставим пометку и
        Exit Do ' выходим в итоге совсем из поиска
        'End If
        
    Loop While iFirstAddress <> iSecondAddress 'ищем, пока не вернёмся на первое совпадение
    
'End If

goout: 'процедура выхода из цикла поиска
'If flag = 0 Then

Next

        'если нет результата поиска или пара не совпадает, тогда пишем пометку в 4-ю ячейку
 'следующая ячейка

End Sub