Sub ee()
Dim F1 As Worksheet, F2 As Worksheet
Dim Plg1 As Range, Plg2 As Range
Dim Cel As Range
Dim C
Set F1 = ThisWorkbook.Sheets("Coordonnées OK_TRIE PAR NOM DES")
Set F2 = Workbooks("export_envoi_coordonnées expé-16 17 09.xls").Sheets("export_envoi_coordonnées expé-1")
Set Plg1 = F1.Range("B2:B" & F1.[B65000].End(xlUp).Row)
Set Plg2 = F2.Range("C2:C" & F2.[C65000].End(xlUp).Row)
F1.Columns(1).Interior.ColorIndex = xlNone
F1.Columns(7).ClearContents
For Each Cel In Plg1
a = UCase(Join(Application.Transpose(Application.Transpose(Cel.Resize(1, 3).Value)), ";"))
Set C = Plg2.Find(Cel, LookAt:=xlWhole)
If Not C Is Nothing Then
Firstaddress = C.Address
b = UCase(Join(Application.Transpose(Application.Transpose(C.Resize(1, 3).Value)), ";"))
If a <> b Then
Do
Set C = Plg2.FindNext(C)
If Not C Is Nothing Then
b = UCase(Join(Application.Transpose(Application.Transpose(C.Resize(1, 3).Value)), ";"))
If a = b Then Exit Do
End If
Loop While Not C Is Nothing And C.Address <> Firstaddress
If a <> b Then Cel.Interior.ColorIndex = 6: Cel.Offset(0, 5) = 1
End If
Else
Cel.Interior.ColorIndex = 3: Cel.Offset(0, 5) = 1
End If
Next Cel
End Sub