Ajouter N° en début de cellules

Option Explicit
Sub Numéroter()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    For Each c In Range(Range("a6"), Range("a6").End(xlDown))
        c = c.Row - 5 & "-" & c
    Next
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Sub Numeroter()
Dim t, i&, n&
With [A6:A999] 'plage à adapter, au moins 2 cellules...
    t = .Value
    For i = 1 To UBound(t)
        If t(i, 1) <> "" Then
            n = n + 1
            t(i, 1) = Format(n, "000-") & t(i, 1)
        End If
    Next
    .Value = t
End With
End Sub

Sub Numeroter()
Dim n&, t, forma, k&

   n = Cells(Rows.Count, "a").End(xlUp).Row
   If n >= 6 Then
      t = Range("a6:a" & n + 1)
      n = Len("" & UBound(t) - LBound(t))
      forma = String(n, "0") & "-"
      For n = 1 To UBound(t) - 1
         k = InStr(t(n, 1), "-")
         If k > 0 Then If Val(Left(t(n, 1), k - 1)) > 0 Then t(n, 1) = Mid(t(n, 1), k + 1)
         t(n, 1) = Format(n, forma) & t(n, 1)
      Next n
      Range("a6").Resize(UBound(t) - 1) = t
   End If
End Sub

Sub Numeroter()
Dim t, i&, n&
With [A6:A999] 'plage à adapter, au moins 2 cellules
    t = .Value
    For i = 1 To UBound(t)
        If t(i, 1) <> "" Then
            n = n + 1
            If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
            t(i, 1) = Format(n, "000-") & t(i, 1)
        End If
    Next
    .Value = t
End With
End Sub

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, i&
With [A6:A999] 'plage à adapter, au moins 2 cellules
    t = .Value
    For i = 1 To UBound(t)
        If t(i, 1) = "" Then t(i, 1) = "zzzzz"
        If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
    Next
    t = Application.Transpose(t)
    tri t, 1, UBound(t)
    t = Application.Transpose(t)
    For i = 1 To UBound(t)
        If t(i, 1) <> "zzzzz" Then t(i, 1) = Format(i, "000-") & t(i, 1) Else t(i, 1) = ""
    Next
    Application.EnableEvents = False
    .Value = t
    Application.EnableEvents = True
End With
End Sub

Sub tri(a, gauc, droi)   ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t, ncol%, i&
With [A6:D999] 'plage à adapter, au moins 2 cellules
    t = .Value
    ncol = UBound(t, 2)
    For i = 1 To UBound(t)
        If t(i, 1) = "" Then t(i, 1) = "zzzzz"
        If t(i, 1) Like "###-*" Then t(i, 1) = Mid(t(i, 1), 5)
    Next
    tri t, 1, UBound(t), ncol
    For i = 1 To UBound(t)
        If t(i, 1) <> "zzzzz" Then t(i, 1) = Format(i, "000-") & t(i, 1) Else t(i, 1) = ""
    Next
    Application.EnableEvents = False
    .Value = t
    Application.EnableEvents = True
End With
End Sub

Sub tri(a, gauc, droi, ncol)  ' Quick sort
Dim ref, g, d, temp, col
ref = a((gauc + droi) \ 2, 1)
g = gauc: d = droi
Do
    Do While a(g, 1) < ref: g = g + 1: Loop
    Do While ref < a(d, 1): d = d - 1: Loop
    If g <= d Then
      For col = 1 To ncol
        temp = a(g, col): a(g, col) = a(d, col): a(d, col) = temp
      Next
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi, ncol)
If gauc < d Then Call tri(a, gauc, d, ncol)
End Sub