Сравнение ячейки с массивом

Sub Oks()
 '--------------------------------------------------------------------------
Dim iLastRow As Long, i As Long, LastRow As Long
 
iLastRow = Sheets("Лист 1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow = Sheets("Лист 2").Cells(Rows.Count, 1).End(xlUp).Row
      For i = 5 To iLastRow
            If Sheets("Лист 2").Cells(i, 1) <> Sheets("Лист 1").Cells(i, 1) Then
                  Sheets("Лист 1").Range(Sheets("Лист 1").Cells(i, 1), Sheets("Лист 1").Cells(i, 2)).Copy Sheets("Лист 2").Cells(LastRow + 1, 1)
                   LastRow = LastRow + 1
                End If
            Next
   End Sub

Sub Oks()
 Dim iLastRow As Long, i As Long, LastRow As Long
iLastRow = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
LastRow = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
       For i = 5 To iLastRow
          For j = 5 To LastRow
            If Sheets("Лист2").Range("A" & j) <> Sheets("Лист1").Range("A" & i) Then
                  Sheets("Лист1").Range(Sheets("Лист1").Cells(i, 1), Sheets("Лист1").Cells(i, 2)).Copy Sheets("Лист2").Cells(LastRow + 1, 1)
                   LastRow = LastRow + 1
                End If
        Next i
    Next j
  
End Sub

Next j
Next i

Sub vvv()
With Sheets("Лист2")
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
a = .Range("A1:A" & Lr).Value
Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        sd.Item(a(i, 1)) = ""
    Next
    
For i = 1 To Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Row
    If Not sd.Exists(Sheets("Лист1").Cells(i, 1).Value) Then
        sd.Item(Sheets("Лист1").Cells(i, 1).Value) = ""
        Lr = Lr + 1
        .Cells(Lr, 1) = Sheets("Лист1").Cells(i, 1)
        .Cells(Lr, 2) = Sheets("Лист1").Cells(i, 2)
    End If
Next
End With
End Sub

Function GetAnotherWorkbook() As Workbook
   On Error Resume Next
    Dim coll As New Collection, wB As Workbook
    For Each wB In Workbooks
        If wB.Name <> ActiveWorkbook.Name Then
            If Windows(wB.Name).Visible Then coll.Add CStr(wB.Name)
        End If
    Next wB
    Select Case coll.Count
        Case 1    ' открыта еще только одна книга - ее и возвращаем
           Set GetAnotherWorkbook = Workbooks(coll(1))
            If IsNumeric(res) Then Set GetAnotherWorkbook = Workbooks(coll(Val(res)))
    End Select
End Function
 
Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 1) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
   ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
   ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
   ' Возвращает коллекцию, содержащую полные пути найденных файлов
   ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
 
    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
   Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
   GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
   Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function
 
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
   ' перебор папок осуществляется в том случае, если SearchDeep > 1
   ' добавляет пути найденных файлов в коллекцию FileNamesColl
   On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке
 
        ' раскомментируйте эту строку для вывода пути к просматриваемой
       ' в текущий момент папке в строку состояния Excel
        'Application.StatusBar = "Поиск в папке: " & FolderPath
 
        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
           If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
       If SearchDeep Then    ' если надо искать глубже
           For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
               GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
   End If
End Function
 
Sub ChangeFolder()    ' для отдельной кнопки - если вдруг надо поменять ранее выбранную папку
   On Error Resume Next: GetFolder , True
End Sub
Function GetFolder(Optional ByVal FolderIndex& = 0, Optional ByVal ShowDialog As Boolean = False, _
                   Optional ByVal Title$ = "Выберите папку", Optional ByVal InitialFolder$) As String
    ' При первом вызове выводит диалогое окно выбора папки
   ' Запоминает выбранную папку, и при следующих вызовах диалоговое окно не выводит,
   ' а возвращает путь к ранее выбиравшейся папке
   ' Используйте вызов с параметром ShowDialog=TRUE для принудительного отображения диалогового окна
   On Error Resume Next: Err.Clear
    ProjectName$ = IIf(Len(PROJECT_NAME$) > 0, PROJECT_NAME$, "SelectFolder")
    PreviousFolder$ = GetSetting(Application.Name, ProjectName$, "folder" & FolderIndex&, "")
    If Len(PreviousFolder$) > 0 And Not ShowDialog Then
        If Dir(PreviousFolder$, vbDirectory) <> "" Then GetFolder = PreviousFolder$: Exit Function
    End If
 
    If InitialFolder$ = "" Then
        If Len(PreviousFolder$) > 0 And Dir(PreviousFolder$, vbDirectory) <> "" Then
            InitialFolder$ = PreviousFolder$    ' начинаем обзор с ранее выбранной папки
       Else
            InitialFolder$ = ThisWorkbook.Path & ""    ' начинаем с текущей папки
       End If
    End If
 
    With Application.FileDialog(msoFileDialogFolderPicker)    ' вывод диалогового окна
       .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialFolder$
        If .Show <> -1 Then Exit Function    ' если пользователь отказался от выбора папки
       GetFolder = .SelectedItems(1)
        If Not Right$(GetFolder, 1) = "" Then GetFolder = GetFolder & ""
        SaveSetting Application.Name, ProjectName$, "folder" & FolderIndex&, GetFolder
    End With
End Function
 
Sub Otd()
On Error Resume Next: Err.Clear
    Dim AskForFolder As Boolean: AskForFolder = 1
    'Not shd.OLEObjects("SaveFolderPath").Object.Value
 
    ' запрашиваем пути к папкам с файлами
    msg1 = "Выберите папку с файлами "
    InvoiceFolder$ = GetFolder(1, AskForFolder, msg1)
    If InvoiceFolder$ = "" Then MsgBox "Не указан папка с файлами", vbCritical, "выполнить макрос невозможно": Exit Sub
 
    Dim coll As Collection
    ' загружаем список файлов по маске имени файла
    Set coll = FilenamesCollection(InvoiceFolder$, "*.xls*", 1)
 
    If coll.Count = 0 Then
        MsgBox "Нет ни одного файла в папке" & vbNewLine & InvoiceFolder$, _
               vbExclamation, "ВНИМАНИЕ!!!"
        Exit Sub
    End If
    
        Dim wB As Workbook, sh As Worksheet, ra As Range
    Application.ScreenUpdating = False  ' отключаем обновление экрана (чтобы процесс открытия файлов не был виден)
 
    ' перебираем все найденные в папке файлы
    For Each Filename In coll
 
       ' открываем очередной файл в режиме «только чтение»
        Set wB = Nothing: Set wB = Workbooks.Open(Filename, False, False)
 
        If wB Is Nothing Then    ' не удалось открыть файл
            pi.Log vbTab & "Ошибка загрузке файла. Файл не сделан."
 
        Else    ' файл успешно открыт
 
'------Start
 
Set WS1 = ActiveWorkbook
Set wB = GetAnotherWorkbook
Application.ScreenUpdating = False
 
With WS1.Sheets("Ресурси")
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
a = .Range("A1:A" & Lr).Value
Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        sd.Item(a(i, 1)) = ""
    Next
    
For i = 5 To wB.Sheets("Ресурси").Cells(Rows.Count, 1).End(xlUp).Row
    If Not sd.Exists(wB.Sheets("Ресурси").Cells(i, 1).Value) Then
        sd.Item(wB.Sheets("Ресурси").Cells(i, 1).Value) = ""
        Lr = Lr + 1
        .Cells(Lr, 1) = wB.Sheets("Ресурси").Cells(i, 1)
        .Cells(Lr, 2) = wB.Sheets("Ресурси").Cells(i, 2)
        .Cells(Lr, 3) = wB.Sheets("Ресурси").Cells(i, 3)
    End If
Next
End With
        
ActiveWorkbook.Save
ActiveWorkbook.Close
 
'------Stop
        
        End If
    Next
 
    ' включаем обновление экрана
    Application.ScreenUpdating = True
    
    MsgBox "Файлы сделаны", vbInformation
     
End Sub