Demande de formule

If n1 = n Then P(i, j) = nom & " " & n2 + 1: GoTo 1
If Trim(P(i1, j1)) Like nom & " #*" Then n2 = n2 + 1

'---RAZ---
For i = 0 To 9
  For j = 1 To Ncol Step 3
    P.Columns(j).Replace " " & i, "", xlPart
    P.Columns(j).Replace i, ""
  Next
Next

Option Compare Text 'si l'on veut que la casse soit ignorée

Sub Numéroter()
Dim choix As Byte, P1 As Range, P2 As Range, P As Range
Dim Nlig%, Ncol%, i%, j%, nom$, n%, n1%, n2%, i1%, j1%
choix = MsgBox(String(20, " ") & "Numéroter ?", 4)
Application.ScreenUpdating = False
Set P1 = [B2:S33] '18 colonnes impérativement
Set P2 = [B35:S72]
With Workbooks.Add.Sheets(1) 'document auxiliaire
  .[A1].Resize(P1.Rows.Count, P1.Columns.Count) = P1.Value
  .[S1].Resize(P2.Rows.Count, P2.Columns.Count) = P2.Value
  Set P = .Range(.[A1], .UsedRange)
  Nlig = P.Rows.Count: Ncol = P.Columns.Count
  '---RAZ---
  For i = 0 To 9
    For j = 3 To Ncol Step 3
      P.Columns(j).Replace " " & i, "", xlPart
      P.Columns(j).Replace i, ""
    Next
  Next
  '---affectation des numéros---
  If choix = 6 Then
    For j = 3 To Ncol Step 3
      For i = 1 To Nlig
        If P(i, j) <> "" Then
          nom = Trim(P(i, j))
          n = n + 1 'numéro de repérage
          n1 = 0: n2 = 0 'n1 numéro de repérage, n2 comptage des noms
          For j1 = 3 To Ncol Step 3
            For i1 = 1 To Nlig
              If P(i1, j1) <> "" Then
                n1 = n1 + 1
                If n1 = n Then P(i, j) = nom & " " & n2 + 1: GoTo 1
                If Trim(P(i1, j1)) Like nom & " #*" Then n2 = n2 + 1
              End If
            Next i1
          Next j1
        End If
1     Next i
    Next j
  End If
  '---restitution---
  P1 = .[A1].Resize(P1.Rows.Count, P1.Columns.Count).Value
  P2 = .[S1].Resize(P2.Rows.Count, P2.Columns.Count).Value
  .Parent.Close False 'suppression du document auxiliaire
End With
End Sub

=SI($A2="";B1;SI(ESTNUM(-($A2&D$1&2013));NOMPROPRE(GAUCHE(TEXTE($A2&D$1&2013;"jjj")));""))

derlig = [Titre1].Parent.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
Set P1 = [Titre1].Cells(2, 2).Resize([Titre2].Row - [Titre1].Row - 1, 18)
Set P2 = [Titre2].Cells(2, 2).Resize(derlig - [Titre2].Row, 18)