XL 2010 Trouver le mot qui manque dans une liste

Sub plager()
Dim O As Worksheet
Dim reponseA As Variant
Dim COL As Byte
Dim reponseB As Variant
Dim PlageA As Range, PlageB As Range, c As Range, Ligne As Long

Set O = Sheets("BDD")
O.Activate
O.Range("I1").CurrentRegion.Offset(0, 1).ClearContents
On Error Resume Next
Set reponseA = Application.InputBox(Prompt:="Veuillez sélectionner n'importe quelle cellule de la première colonne.", Type:=8)
If reponseA Is Nothing Then Exit Sub
COL = reponseA.Column
Set PlageA = O.Range(O.Cells(5, COL), O.Cells(Application.Rows.Count, COL).End(xlUp))
Set reponseB = Application.InputBox(Prompt:="Veuillez sélectionner n'importe quelle cellule de la seconde colonne.", Type:=8)
If reponseB Is Nothing Then Exit Sub
COL = reponseB.Column
Set PlageB = O.Range(O.Cells(5, COL), O.Cells(Application.Rows.Count, COL).End(xlUp))
Ligne = 1
For Each c In PlageA
    If WorksheetFunction.CountIf(PlageB, c.Value) = 0 Then
    Range("J" & Ligne).Value = c.Value
    Ligne = Ligne + 1
    End If
Next c
Sheets("ListeCopierColler").Activate
End Sub

Sub CreerListes()
With Feuil2.[A5:B6000] 'plage de 2 colonnes, à adapter
  .Formula = "=TEXT(RANDBETWEEN(1,1200),""P0000"")" 'ALEA.ENTRE.BORNES
  .Value = .Value 'supprime les formules
  Call Comparer(.Cells, Feuil2.[E5]) 'cellule de restitution à adapter
End With
End Sub

Sub Comparer(plage As Range, restit As Range)
Dim d1 As Object, d2 As Object, t, i&, a, manque(), m&, plus(), p&
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
d1.CompareMode = vbTextCompare 'la casse est ignorée
d2.CompareMode = vbTextCompare 'la casse est ignorée
'---listes sans doublons---
t = plage.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(t): d1(t(i, 1)) = "": Next
For i = 1 To UBound(t): d2(t(i, 2)) = "": Next
'---manque---
If d1.Count Then
  a = d1.keys
  ReDim manque(1 To d1.Count, 1 To 1)
  For i = 0 To UBound(a)
    If Not d2.exists(a(i)) Then m = m + 1: manque(m, 1) = a(i)
  Next
End If
'---plus---
If d2.Count Then
  a = d2.keys
  ReDim plus(1 To d2.Count, 1 To 1)
  For i = 0 To UBound(a)
    If Not d1.exists(a(i)) Then p = p + 1: plus(p, 1) = a(i)
  Next
End If
'---restitution sur restit et tris---
Application.ScreenUpdating = False
restit.Resize(Rows.Count - restit.Row + 1, 2) = "" 'RAZ
If m Then restit.Resize(m) = manque: restit.Resize(m).Sort restit
If p Then restit(1, 2).Resize(p) = plus: restit(1, 2).Resize(p).Sort restit(1, 2)
Set restit = Cells.Find(restit, , xlValues, , xlByColumns) 'initialise la boîte de dialogue Rechercher
End Sub