Gestion des erreurs

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col1 As Range, col2 As Range, ref As Range, txt$
On Error Resume Next
Set col1 = Rows(1).Find("CODE POSTAL", LookIn:=xlFormulas, LookAt:=xlPart).Offset(1).Resize(Rows.Count - 1)
Set col2 = Rows(1).Find("BUREAU DISTRIBUTEUR").Offset(1).Resize(Rows.Count - 1)
If Intersect(Target, Union(col1, col2)) Is Nothing Then Exit Sub
With Sheets("CODESPOSTAUX")
Set ref = .Range("A:B").Find(Target, LookAt:=xlWhole)
If IsNumeric(Target) And Not Intersect(Target, col1) Is Nothing Then
txt = .Cells(ref.Row, 2)
ElseIf Not IsNumeric(Target) And Not Intersect(Target, col2) Is Nothing Then
txt = .Cells(ref.Row, 1)
End If
End With
Application.EnableEvents = False
Cells(Target.Row, IIf(Intersect(Target, col1) Is Nothing, col1.Column, col2.Column)) = txt
Application.EnableEvents = True
End Sub

Cliquez pour agrandir...

On Error GoTo fin 'si le code n'existe pas ou une erreur de saisie (lettres)
Target.Offset(0, -1).Value = Sheets("CODEPOSTAUX").Columns(2).Find(Target.Value, , xlValues, xlWhole).Offset(0, -1)
End
fin:
MsgBox "Le bureau n'existe pas !", , "Attention"
Application.EnableEvents = False
Target = ""
Target.Offset(0, 0).Select
Application.EnableEvents = True

Cliquez pour agrandir...