Numérotation automatique pr archivage

[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim ocel As Range, i As Long, nDat As Long, y As String
Dim numArcCol As Long, datArcCol As Long
   numArcCol = 6 [B][COLOR="SeaGreen"]'Numéro de la colonne "Numéro d'archive"[/COLOR][/B]
   datArcCol = 5[B][COLOR="SeaGreen"] 'Numéro de la colonne "Date d'archivage"[/COLOR][/B]
   If Not Intersect(Target, Columns(datArcCol)) Is Nothing Then
      For Each ocel In Intersect(Target, Columns(datArcCol))
         If IsEmpty(ocel) Or IsDate(ocel) Then
         On Error GoTo E
         Application.EnableEvents = False
         Cells(ocel.Row, numArcCol) = Empty
         If Not IsEmpty(ocel) Then
            nDat = 0
            y = "A" & Year(ocel.Value)
            For i = 2 To Cells(Rows.Count, numArcCol).End(xlUp).Row
               If Cells(i, numArcCol) Like y & "*" Then nDat = WorksheetFunction.Max(nDat, CLng(Right$(Cells(i, numArcCol), 2)))
            Next i
            Cells(ocel.Row, numArcCol).Value = y & Format(nDat + 1, "00")
         End If
R:       On Error GoTo 0
         Application.EnableEvents = True
         End If
      Next ocel
   End If
Exit Sub
E: Resume R
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ocel As Range
Dim numArcCol As Long, datArcCol As Long
   numArcCol = 6 'Numéro de la colonne "Numéro d'archive"
   datArcCol = 5 'Numéro de la colonne "Date d'archivage"
   If Not Intersect(Target, Columns(datArcCol)) Is Nothing Then
      For Each ocel In Intersect(Target, Columns(datArcCol))
         If Not IsEmpty(Cells(ocel.Row, numArcCol)) And Not IsEmpty(ocel) Then
            If MsgBox("Modifier la valeur ?", vbYesNo) = vbYes Then ocel.Value = ocel.Value
         End If
      Next ocel
   End If
End Sub[/B][/COLOR]