Modif code VBA

Option Explicit
Sub toto()
'  ***  10 Ventôse CCXIX  ***  Roger fecit.  ***
'
'Référence à la biliothèque Microsoft Scripting Runtime (scrrun.dll) requise.
'"dat" est une plage nommée de la feuille "Base" :
'=DECALER(Base!$A$1;;;MAX((DECALER(Base!$A$1;;;NEnr;1)<>"")*LIGNE(DECALER(Base!$1:$1;;;NEnr;)));MAX((DECALER(Base!$A$1;;;;NChp)<>"")*COLONNE(DECALER(Base!$A:$A;;;;NChp))))
'Adapter les paramètres nommé "NEnr" (nb. max d'enregistrements) et "NChp" (nb. max de champs) si besoin est.
'
Dim i&, j&, ind$, tmp$, Chp(), oSh(), oKeys(), oItms(), oDt As Scripting.Dictionary
Dim DL As Long, Ligne As Long
Dim c
  Chp = Array( _
    Array("Nom", "Nom", "E6"), _
    Array("Fonction", "Fonction", "E10"), _
    Array("Néle", "Néle", "A1"), _
    Array("Etat", "Etat", "N14"))
 'correspondance des champs des feuilles "base" et "releve", DANS L'ORDRE DES CHAMPS DE "base".
  
  With Range("dat")
    If .Rows.Count = 1 Then Exit Sub  'Rien à traiter.
    For i = 0 To UBound(Chp)
      If Chp(i)(0) <> .Cells(1, 1 + i) Then MsgBox ("Base inadéquate"): Exit Sub 'Base inadéquate.
    Next
'
'Ventilation de la base par onglet :
    Set oDt = CreateObject("Scripting.Dictionary")
    
    '*************************************************************************************************************
    'C'est ici que tu peux remplacer la ligne de début pour la boucle
    DL = .Rows.Count
    Set c = Range(Cells(1, 1), Cells(DL, 1)).Find("Nom", LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        Ligne = c.Row
    Else
        Exit Sub
    End If
    
    '*************************************************************************************************************
    
    For i = Ligne To .Rows.Count
      ind = .Cells(i, 1)
      tmp = ""
      Do While oDt.Exists(ind & tmp): tmp = " " & CStr(Val(tmp) + 1): Loop 'Gestion des homonymies.
      oDt.Add ind & tmp, Array(ind & tmp, .Rows(i).Value)
    Next
  End With
'
'Répertoire des feuilles existantes :
  ReDim oSh(1 To Sheets.Count)
  For i = 1 To Sheets.Count: oSh(i) = Sheets(i).Name: Next
'
'création/mise à jour des onglets :
  oKeys = oDt.Keys
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For i = 0 To oDt.Count - 1
    For j = 1 To UBound(oSh)
      If oKeys(i) = oSh(j) Then Exit For
    Next j
    If j > UBound(oSh) Then 'Nouvelle feuille
      Worksheets("Releve").Copy Before:=Worksheets("Releve")
      ActiveSheet.Name = oKeys(i)
    Else 'Feuille existante
      Worksheets(oKeys(i)).Activate
    End If
    oItms = oDt(oKeys(i))(1)
    For j = 0 To UBound(Chp): ActiveSheet.Range(Chp(j)(2)) = oItms(1, j + 1): Next
  Next i
  Me.Activate
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  Set oDt = Nothing: Erase Chp(), oSh(), oKeys(), oItms()
End Sub

Private Sub CommandButton1_Click()
  toto
End Sub

'Ventilation de la base par onglet :
    Set oDt = CreateObject("Scripting.Dictionary")
    For i = 2 To .Rows.Count                                  'Ici 2 signifie ligne 2
      ind = .Cells(i, 1)
      tmp = ""
      Do While oDt.Exists(ind & tmp): tmp = " " & CStr(Val(tmp) + 1): Loop 'Gestion des homonymies.
      oDt.Add ind & tmp, Array(ind & tmp, .Rows(i).Value)
    Next
  End With