Comment numéroter (incrémenter) automatiquement ses numéros de factures ou d'autres clefs ?

Cet article couvre les 15 premières minutes de la formation sur les tableaux que je donne ici.

Cette question des numéros de facture est peut-être la plus ancienne d'Excel, mais elle est toujours parmi les plus demandés ! Il existe de nombreux réponses possibles, mais voici un code un peu plus poussé qui présente beaucoup d'avantages :

  • Pas d'utilisation de la solution avec xlUp qui peut générer des erreurs si des données sont entrées en dessous de la table ou si on dépasse un certain nombre de lignes - en fonction du code trouvé sur internet.
  • Gestion du cas d'une table vide.
  • Possibilité d'ajouter très rapidement plusieurs lignes au lieu d'une seule.
  • Positionnement direct sur la dernière ligne après l'ajout.
  • Avec un tableau, les formules et les formats sont recopiés automatiquement vers le bas.

Téléchargez le fichier.

Installation en vidéo

Pour un nouveau fichier

  • Utilisez un tableau structuré pour stocker vos factures : Accueil, Mettre sous forme de tableau
  • Renommez le tableau structuré, ici T_Data
  • Suivre la suite des étapes

Pour un fichier existant contenant déjà un tableau structuré

  • Copiez le code ci-dessous dans un nouveau module : ALT+F11, Insertion - Module
  • Revenez sur Excel, puis ajoutez un bouton.
    Vous pouvez utiliser les nouveautés d'Excel avec Insertion :
  • Associez-y ce code via un clic droit sur l’icône, affecter une macro et choisir AjouterUneLigne.

Explication du code en vidéo

Le code

Option Explicit
Sub AjouterUneLigne()
    AjouterNLignes loData, 1, 1
    GoToDerniereLigneDuTableau loData, 10
End Sub
Sub Ajouter5Lignes()
    AjouterNLignes loData, 5, 1
    GoToDerniereLigneDuTableau loData, 10
End Sub
Private Sub GoToDerniereLigneDuTableau(loTable As ListObject, nLignesVisibles As Long)
    Dim rLastCell As Range
    Set rLastCell = loTable.DataBodyRange.Resize(1, 1).Offset(loTable.DataBodyRange.Rows.Count - 1)
    On Error Resume Next 'au cas ou on est en haut de la feuille
    Application.Goto rLastCell.Offset(-nLignesVisibles, 1), True
    On Error GoTo 0
    Application.Goto rLastCell, False
End Sub
Private Sub AjouterNLignes(loTable As ListObject, nRow As Long, lColKey As Long)
    'on aurait pu faire une boucle ajoutant nRow lignes,
    'mais le redimensionnement - resize - est (beaucoup) plus rapide que l'ajout
    'd'une ligne à la suite.
    Dim lMax As Long
    Dim lNbRowsStart As Long
    'aucune donnee, on demarre la numerotation a 1
    If loTable.DataBodyRange Is Nothing Then
        loTable.ListRows.Add (1)
        If nRow <> 1 Then loTable.Resize loTable.Range.Resize(loTable.Range.Rows.Count + nRow - 1)
        loTable.DataBodyRange.Resize(, 1).Offset(, lColKey - 1).Value = _
            fctSequence(nRow, 1, 1, 1)
            'Application.WorksheetFunction.Sequence(nRow, 1)'unqiuement en excel 365
    Else
        lNbRowsStart = loTable.DataBodyRange.Rows.Count
        lMax = Application.WorksheetFunction.Max(loTable.DataBodyRange.Columns(lColKey))
        loTable.Resize loTable.Range.Resize(loTable.Range.Rows.Count + nRow)
        loTable.DataBodyRange.Resize(nRow, 1).Offset(lNbRowsStart, lColKey - 1).Value = _
            fctSequence(nRow, 1, lMax + 1, 1)
        'Application.WorksheetFunction.Sequence(nRow, 1, lMax + 1) 'si vous etes en excel 365
    End If
End Sub
Private Function fctSequence(lRow As Long, lCol As Long, lStart As Long, lStep As Long)
    Dim arrSequence As Variant
    ReDim arrSequence(1 To lRow, 1 To lCol) As Variant
    Dim lRowLoop As Long, lColLoop As Long
    Dim lValue As Long
    lValue = lStart
    For lRowLoop = 1 To lRow
        For lColLoop = 1 To lCol
            arrSequence(lRowLoop, lColLoop) = lValue
            lValue = lValue + lStep
        Next
    Next
    fctSequence = arrSequence
End Function
Private Function loData() As ListObject
    'Set loData = wksData.ListObjects("T_Data") 'au cas où l'on veut faire fonctionner la macro a partir d'une autre feuille
    Set loData = ActiveSheet.ListObjects(1)
End Function
Pour marque-pages : Permaliens.

Laisser un commentaire

Votre adresse e-mail ne sera pas publiée. Les champs obligatoires sont indiqués avec *


La période de vérification reCAPTCHA a expiré. Veuillez recharger la page.

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.