[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Champ_Nom$, Champ_IDn$, Nom%, IDn%, oCl&[COLOR="Red"], tf As Boolean[/COLOR]
Dim n&, oPlg As Object, oCel As Range, oColl As New Collection
'
Champ_Nom = "NOM" 'intitulé de la colonne des Noms
Champ_IDn = "ID" 'intitulé de la colonne des Identifiants
'
oCl = Cells(1, Columns.Count).End(xlToLeft).Column
With Range(Cells(1, 1), Cells(1, oCl))
For Nom = 1 To oCl
If .Cells(1, Nom) Like Champ_Nom Then Exit For
Next
For IDn = 1 To oCl
If .Cells(1, IDn) Like Champ_IDn Then Exit For
Next
End With
If Nom > oCl Or IDn > oCl Then GoTo W_C2
n = FU9ONQ9HIFHSKNUQ.[A1].Value
Set oPlg = Intersect(Target, Columns(Nom).Resize(Rows.Count - 1, 1).Offset(1, 0))
If Not oPlg Is Nothing Then
With Range(Cells(1, IDn), Cells(Rows.Count, IDn).End(xlUp))
For Each oCel In .Cells
If oCel.Value Like "U####" Then
On Error Resume Next
oColl.Add Item:=oCel.Value, Key:=CStr(oCel.Value)
If Err.Number <> 0 Then GoTo E
On Error GoTo 0
n = WorksheetFunction.Max(n, Val(Right$(oCel.Value, 4)))
End If
Next oCel
End With
Application.Calculation = xlCalculationManual
For Each oCel In oPlg.Cells
If n = 9999 Then MsgBox "Tous les identifiants ont été attribués." & vbLf & "Désolé...": Exit For
[COLOR="Red"]If Not IsEmpty(oCel.Offset(0, IDn - Nom)) And Not IsEmpty(oCel) Then tf = MsgBox("Voulez-vous remplacer l'ancien idendifiant ?", vbYesNo) = vbYes[/COLOR]
If [COLOR="Red"]([/COLOR]IsEmpty(oCel.Offset(0, IDn - Nom)) [COLOR="Red"]Or tf)[/COLOR] And Not IsEmpty(oCel) Then
n = n + 1
Application.EnableEvents = False
oCel.Offset(0, IDn - Nom).Value = "U" & Format(n, "0000")
Application.EnableEvents = True
End If
Next oCel
FU9ONQ9HIFHSKNUQ.[A1].Value = n
S: Application.Calculation = xlCalculationAutomatic
End If
Set oPlg = Nothing
' Suite de la procédure Worksheet_Change
W_C2:
Exit Sub
E: MsgBox "L'identifiant " & oCel.Value & " n'est pas unique." & vbLf & "Vérifier la colonne " & IDn & "."
Err.Number = 0
Resume S
End Sub[/B][/COLOR]