Sub test()
Dim Wb As Workbook
'Dim ok As Boolean
On Error GoTo fin
[O2:Q10000].ClearContents
fichier = ThisWorkbook.Path & "\Norme.xls"
Set Wb = GetObject(fichier)
With Wb.Sheets("Feuil1")
For lig = 2 To Cells(Rows.Count, 11).End(3).Row
c1 = Application.Match(Cells(lig, 13), .Range("C1:C10000"), 0) 'code1
If IsNumeric(c1) Then
If .Cells(c1, 4) = Cells(lig, 14) And Left(Cells(lig, 11), 4) = Left(.Cells(c1, 1), 4) Then GoTo bas 'tout ok on va à Next
If Left(Cells(lig, 11), 4) = Left(.Cells(c1, 1), 4) Then Cells(lig, "P") = .Cells(c1, 4): GoTo bas 'code1 & 4 lettres ok, on rectif code2
End If
c1 = Application.Match(Cells(lig, 14), .Range("D1:D10000"), 0) 'code2
If IsNumeric(c1) Then 'si code2 ok & libellé ok on rectif code1 et va à next
If Left(Cells(lig, 11), 4) = Left(.Cells(c1, 1), 4) Then Cells(lig, "O") = .Cells(c1, 3): GoTo bas
End If
'code1 & code2 ne sont pas bon alors on boucle pour trouver les 4 premières lettres du libellé
For k = 2 To .[A65000].End(3).Row
If Left(Cells(lig, 11), 4) = Left(.Cells(k, 1), 4) Then
Cells(lig, "O") = .Cells(k, 3): Cells(lig, "P") = .Cells(k, 4): Exit For
End If
Next
bas: 'routine
Next
End With
fin:
Wb.Close
End Sub