Microsoft 365 VBA : Numérotation de lignes à partir d'une ligne vide

[GMeunier]

Bonjour,
J'ai un code (Merci Excel Downloads!) qui me permet de poursuivre automatiquement la numérotation des lignes à partir du numéro de la dernière ligne existante lorsque je rajoute automatiquement d'autres lignes dans un tableau structuré.
Toutefois ce code ne fonctionne que si il y a déjà une ligne avec un n°. Je voudrais pouvoir gérer le cas où la 1° ligne du tableau est vide (Bien sûr , je peux créer une 1° ligne vide avec le numéro 1 - mais ce serait plus professionnel et puis dans ce cas la ligne n°1 reste vide).
J'ai essayé diverses options avec If Range("A5").Value ="" pour créer un N°1 mais je veux que la 1° ligne ajoutée soit attribuée à ce numéro, ce qui n'est pas le cas avec ma modification. Ma maîtrise du VBA n'est pas encore suffisante!
Voici le code :

Sub RtionProject_NumAuto()
'Repart de la valeur la plus élevée quelque soit l'ordre de tri
  Dim i As Long, Maxi As Long
  With Sheets("RtionProjet_Data").ListObjects("Ta_RtionProjet_Data")
    Maxi = Application.Max(.ListColumns(1).DataBodyRange)
    For i = 1 To .ListRows.Count
      If .ListRows(i).Range(1) = "" Then
        Maxi = Maxi + 1
        .ListRows(i).Range(1) = Maxi
      End If
    Next i
  End With
End Sub

Donc ma question : Comment gérer le cas où la 1° ligne du tableau est vide pour que la 1° ligne ajoutée prenne le n°1.

Merci d'avance et ... Bonne Année!

 

[Robert]

Bonsoir GMeunier, bonsoir le forum,

Pas sûr d'avoir bien compris... Peut-être comme ça :

Sub RtionProject_NumAuto()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TS As ListObject 'déclare la variable TS (Tableau Structuré)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Long 'déclare la variable I (Incrément)

Set O = Worksheets("RtionProjet_Data") 'définit l'onglet O
Set TS = O.ListObjects("Ta_RtionProjet_Data") 'définit le tableau structuré TS
Set PL = TS.DataBodyRange 'définit la plage PL
For I = 1 To PL.Rows.Count 'boucle sur toutes les lignes I de la plage PL
    PL(I, 1).Value = I 'définit la valeur de la cellule ligne I colonne 1 de la plage PL
Next I 'prochaine ligne de la boucle
End Sub

 

[GMeunier]

Robert,
Merci pour la réponse. En fait le code initial fonctionne très bien lorsque j'ajoute simplement de nouvelles lignes au tableau existant. Il va chercher la dernière valeur (Num ID dans la 1° colonne) dans le tableau existant et l'incrémente pour les lignes ajoutées. Chaque fois que j'ajoute de nouvelles lignes, la macro va chercher la dernière valeur de Num ID (sans tout renuméroter!) et l'incrémente. C'est OK.
Ma question concerne le cas où je démarre avec un tableau structuré vide. La première ligne ne contient pas de valeur 1. Si je crée cette ligne vide afin d'avoir un n° 1 sur lequel la macro va pouvoir incrémenter pour les lignes ajoutées, ça marche mais cette ligne restera vide.
J'aimerais bien une modification de la macro initiale pour qu'elle teste s'il y a une ligne avec un numéro, si oui elle fonctionne telle qu'elle est, sinon que la macro attribue le numéro 1 à cette première ligne vide et y colle la première ligne à ajouter.
Bien cordialement
Gérard

 

[Robert]

Re,
C'est ce que j'avais compris mais il me semblait que le code que je te proposais faisait la même chose en renumérotant systématiquement... Si tu n'as aucune ligne sans numéro, ça revient au même non ?

 

[job75]

Bonsoir GMeunier, Robert,

Vous pouvez entrer une formule de numérotation automatique en 1ère colonne du tableau :

Sub RtionProject_NumAuto()
With Sheets("RtionProjet_Data").ListObjects(1).Range.Columns(1)
    .Cells(2).Resize(.Rows.Count - 1) = "=N(OFFSET(RC,-1,))+1"
End With
End Sub

Cette macro ne devrait servir qu'une fois puisque la formule se recopiera automatiquement vers le bas.

A+

 

[GMeunier]

En fait, il ne faut pas renuméroter à chaque fois sinon ce n'est plus un numéro d'identification s'il peut changer.
Mon problème est juste lors du premier ajout de lignes si je le fais dans un tableau vide. Comment donner le numéro 1 à cette première ligne vide (s'il y en a une une) et faire en sorte que la première ligne copiée y soit (je sais comment créer la première ligne avec le code 1 mais la macro actuelle va copier la nouvelle ligne en 1+1 et la ligne 1 reste vide.

 

[GMeunier]

Job75,
Merci pour la réponse, je testerai demain matin avec les idées claires!
Gérard

 

[Phil69970]

Bonjour à tous

@GMeunier :
Une piste ....non testé

Sub TestTableau()
If Range("Tableau1").ListObject.DataBodyRange Is Nothing Then
    'Tableau vide
    'Mon code ici si tableau vide
Else
    'Tableau remplit
    'Mon code ici si tableau remplit
End If
End Sub

*Le nom du tableau est à adapter😉

@Phil69970

 

[job75]

S'il s'agit de numéros d'identification une formule ne convient pas.

Car ces numéros changeraient quand on insère ou supprime des lignes.

[Edit] ou quand on trie le tableau.

Utilisez alors cette macro, à placer dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si aucune SpecialCell
With ListObjects(1).Range.Columns(1)
    For Each c In .SpecialCells(xlCellTypeBlanks)
        c = Application.Max(.Cells) + 1
    Next
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Bien sûr il ne faudra pas modifier manuellement la 1ère colonne...

Bonsoir Phil69970.

 

[GMeunier]

Merci à tous, je vérifie et je reviens !
Gérard

 

[GMeunier]

Bonjour à tous

@GMeunier :
Une piste ....non testé

Sub TestTableau()
If Range("Tableau1").ListObject.DataBodyRange Is Nothing Then
    'Tableau vide
    'Mon code ici si tableau vide
Else
    'Tableau remplit
    'Mon code ici si tableau remplit
End If
End Sub

*Le nom du tableau est à adapter😉

@Phil69970

Phil69970,
Merci pour le guidage! Après quelques errances, mon code fonctionne sur la base que vous avez proposé!
Encore merci et vive la communauté!
Gérard

 

[Phil69970]

Re

Comme nous sommes sur un site de partage il serait sympa de ...... partager le code qui t'as permis de solutionner ta question

De même la logique est de marquer en résolu la solution qui correspond le plus à ta solution.

@Phil69970

 

[GMeunier]

Désolé Phil69970! Il me semble que j'ai mis Résolu, sur ta réponse. Peut-être pas au bonne endroit!

J'ai d'ailleurs soulevé une autre question dans le forum concernant la dernière macro qui coupe et colle les fichiers qui ont été ajoutés. Ce code est la 3° macro du code ci-dessous:
La voici :
J'ai un code qui me permet de copier l'ensemble des fichiers d'un répertoire, de les coller dans un second répertoire et de les effacer du premier.
Si je fais cette manip. à la main et que les fichiers sont déjà présents dans le second répertoire, j'ai un message "Remplacer ou ignorer". Par contre si j'utilise la macro, le code ne réagit pas, que les fichiers que je veux copier soient déjà présents ou pas dans le répertoire de destination.
1° J'aimerais comprendre ce qui entraine ce comportement dans ce code et
2° J'aimerais avoir le code pour une MsGBox m'avertissant que ces fichiers prêts à être collés sont déjà présents.

Voici le code général:

Sub Actua_Rtion_Data()
'Ajout de la feuille RtionProjet_MàJ à RtionProjet_Data
'Requête Mise à jour
If Sheets("Rtionprojet_MàJ").Range("A5") = "Source.Name" Then
' Tableau de destination vide (pas de 1° ligne)
If Range("Ta_RtionProjet_Data").ListObject.DataBodyRange Is Nothing Then
MsgBox "Confirmer la mise à jour de la base", vbOKCancel
'Suppression de la 1° colonne de "Réalisation_MaJ"
Sheets("RtionProjet_MàJ").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'Remise à blanc de la colonne N°
Range("A:A").Clear
'Copy de RtionProjet_MaJ dans RtionProjet_Data
Sheets("RtionProjet_MàJ").ListObjects("Ta_RtionProjet_MàJ").DataBodyRange.Copy Sheets("RtionProjet_Data").Cells(5, 1)
'Affecter le numéro 1 à la 1° ligne (vide)
Sheets("RtionProjet_Data").Range("A5").Value = 1
'Tableau de destination déjà rempli
Else
Dim ligne As Long
'Numéro de la première ligne vide de la base de données
ligne = Sheets("RtionProjet_Data").Range("A1048576").End(xlUp).Row + 1
'Confirmation et copie de la mise à jour
MsgBox "Confirmer la mise à jour de la base", vbOKCancel
'Suppression de la 1° colonne de "Réalisation_MaJ"
Sheets("RtionProjet_MàJ").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
'Remise à blanc de la colonne N°
Range("A:A").Clear
'Copy de RtionProjet_MaJ dans RtionProjet_Data
Sheets("RtionProjet_MàJ").ListObjects("Ta_RtionProjet_MàJ").DataBodyRange.Copy Sheets("RtionProjet_Data").Cells(ligne, 1)
End If
'Compléter la numérotation
Call RtionProject_NumAuto
' Couper-Coller les Feuilles de Collecte dans le répertoire de sauvegarde
Call RtionProject_MàJ_Sauvegarde
' Gestion du cas où la requête n'a pas été mise à jour
Else
MsgBox "La requête n'a pas été mise à jour!"
Exit Sub
End If
End Sub

Sub RtionProject_NumAuto()
'Poursuite de la numérotation (colonne 1)lors de l'ajout de nouvelles lignes
Dim i As Long, Maxi As Long
With Sheets("RtionProjet_Data").ListObjects("Ta_RtionProjet_Data")
'Recherche du n° existant maximum
Maxi = Application.Max(.ListColumns(1).DataBodyRange)
For i = 1 To .ListRows.Count
If .ListRows(i).Range(1) = "" Then
Maxi = Maxi + 1
.ListRows(i).Range(1) = Maxi
End If
Next i
End With
End Sub

Sub RtionProject_MàJ_Sauvegarde()
'Sauvegarde des mises à jour ajoutées dans C://PACTE_SSE\B-DATA/REALISATIONC1C2\RtionProjet_MaJ dans le sous-répertoire RtionProjet_Sauvegarde
Dim NomFich As String
Dim OldRep As String, NewRep As String
OldRep = "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\RtionProjet_MàJ\"
NewRep = "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\RtionProjet_Sauvegarde\"
NomFich = Dir(OldRep & "*.xlsx", 2)
Do While NomFich <> ""
If (GetAttr(OldRep & NomFich) And vbNormal) = vbNormal Then
FileCopy OldRep & NomFich, NewRep & NomFich
End If
NomFich = Dir()
Loop
' Remise à blanc du sous-répertoire "RtionProjet_MaJ"
Kill ("C:\PACTE_SSE\B-DATA\REALISATIONC1C2\RtionProjet_MàJ\" & "*.xlsx")
'Retour feuille "RtionProjet_Data"
Sheets("RtionProjet_Data").Activate
Range("A1").Select
End Sub[/CODE]

 

[job75]

Bonjour le forum,

Je continue sur la numérotation qui est le sujet du post #1.

Bien sûr il ne faudra pas modifier manuellement la 1ère colonne...

Pour l'éviter on peut utiliser cette macro qui empêche sa sélection, voyez le fichier joint :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ListObjects(1).Range.Offset(1)
    If Not Intersect(Target, .Columns(1)) Is Nothing Then _
        Intersect(Target.EntireRow, .Columns(2)).Select
End With
End Sub

A+

 

[GMeunier]

Job75, merci. Il faut que j'étudie ce code!
Ceinture et bretelles! Mais à priori, il n'y a pas de risque de vouloir supprimer une colonne car ce tableau ne sert qu'à stocker les données qui seront exploitées ailleurs dans un modèle de données.
Gérard