Sub idem()
Set f1 = Sheets("BD1")
Set f2 = Sheets("BD2")
Set f3 = Sheets("BD1 - BD2")
Set mondico1 = CreateObject("Scripting.Dictionary")
Set mondico2 = CreateObject("Scripting.Dictionary")
Set mondico = CreateObject("Scripting.Dictionary")
'recherche doublons de col B en BD2
For Each c In f2.Range("b2", f2.[b65000].End(xlUp))
If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1
Next c
lig = 2
For Each c In f2.Range("b2", f2.[b65000].End(xlUp))
If mondico.Item(c.Value) > 1 Then
MsgBox ("Vous avez un doublon de Nom Prénom et colonne B de la feuille BD2" & vbCr & "Corrigez cette erreur en feuille BD2, Sauvez et recommencez le test!" & vbCr & "le nom prénom est: " & c)
Exit Sub
End If
lig = lig + 1
Next c
'*******************************************
a = f1.Range("B2:B" & f1.[b65000].End(xlUp).Row)
b = f2.Range("B2:B" & f2.[b65000].End(xlUp).Row)
tablo1 = f1.Range("A2
" & f1.[D65000].End(xlUp).Row)
tablo2 = f2.Range("A2
" & f2.[D65000].End(xlUp).Row)
For i = LBound(a) To UBound(a)
mondico1(a(i, 1)) = ""
Next i
For i = LBound(b) To UBound(b)
mondico2(b(i, 1)) = ""
Next i
pos = 2
For Each c In b
If mondico1.exists(c) Then
If mondico2.exists(c) Then
mondico2(c) = ""
p = Application.Match(c, mondico1.keys, 0)
q = Application.Match(c, mondico2.keys, 0)
For tr = 1 To 4
f3.Cells(pos, tr) = tablo1(p, tr)
Next tr
f3.Cells(pos, 5) = tablo2(q, 1)
pos = pos + 1
End If
End If
Next c
End Sub