Numéro ID unique

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ltr$, ind%, col, MInd, oCel As Range, x As Object
  col = "A" 'Colonne des identifiants (1 ou "A", 2 ou "B", …, 28 ou "AB", …)
  With [C4] 'Première cellule de saisie
    col = colNum(col) - .Column
    Set x = Intersect(.Resize(Rows.Count - .Row, 1), Target)
    If Not x Is Nothing Then
      Application.Calculation = -4135
      On Error GoTo DefRef
      MInd = Evaluate(ThisWorkbook.Names("MaxIndex").Value)
      On Error GoTo 0
      For Each oCel In x.Cells
        If IsEmpty(oCel) Then
          Application.EnableEvents = 0
          oCel.Offset(0, col).Value = ""
          Application.EnableEvents = 1
        Else
          If oCel.Offset(0, col).Value = "" Then
            ltr = carNet(UCase(Left$(oCel.Value, 1)))
            ind = Asc(ltr) - 64
            If ind < 1 Or 26 < ind Then ltr = "#": ind = 27
            MInd(ind) = MInd(ind) + 1
            Application.EnableEvents = 0
            oCel.Offset(0, col).Value = ltr & Format(MInd(ind), "00000")
            Application.EnableEvents = 1
          End If
        End If
      Next oCel
      ThisWorkbook.Names.Add Name:="MaxIndex", RefersTo:=MInd
      Application.Calculation = -4105
    End If
  End With
Exit Sub
' Initialisation
DefRef:
  rst
  Resume
End Sub

Sub rst()
  ThisWorkbook.Names.Add Name:="MaxIndex", RefersTo:=Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
End Sub

Private Function carNet$(s$)
Dim rEq$, oEq$
  carNet = s
  rEq = " ÀÁÂÃÄÅÆÇÈÉÊËÐÌÍÎÏÑÒÓÔÕÖŒÙÚÛÜÝŸ"
  oEq = " AAAAAAACEEEEEIIIINOOOOOOUUUUYY"
  On Error Resume Next
  carNet = Mid$(oEq, InStr(1, rEq, s, vbBinaryCompare), 1)
  On Error GoTo 0
End Function

Function colNum(x As Variant)
  Select Case VarType(x)
    Case 2 To 5, 17: colNum = colValid(Int(x))
    Case 8
      x = UCase(x)
      colNum = Asc(Right$(x, 1)) - 64
      If Len(x) > 1 Then colNum = colNum + 26 * (Asc(Mid$(StrReverse(x), 2, 1)) - 64)
      colNum = colValid(colNum)
    Case Else: Error 5
  End Select
End Function

Function colValid(x)
  colValid = ((Columns.Count + 2 + x - Abs(Columns.Count - x)) / 2 + Abs((Columns.Count - 2 + x - Abs(Columns.Count - x)) / 2)) / 2
End Function