Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

G

GMeunier

XLDnaute Nouveau
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 :
VB: 
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!
 
Solution
G
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
Trier par date Trier par votes

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir GMeunier, bonsoir le forum,

Pas sûr d'avoir bien compris... Peut-être comme ça :
VB: 
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
 
Vote positif 0 Vote négatif
G

GMeunier

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif

Robert

XLDnaute Barbatruc
Repose en paix
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 ?
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonsoir GMeunier, Robert,

Vous pouvez entrer une formule de numérotation automatique en 1ère colonne du tableau :
VB: 
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+
 
Vote positif 0 Vote négatif
G

GMeunier

XLDnaute Nouveau
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.
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
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 :
VB: 
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.
 
Dernière édition:
Vote positif 0 Vote négatif
G

GMeunier

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Solution
G

GMeunier

XLDnaute Nouveau
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]
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonjour le forum,

Je continue sur la numérotation qui est le sujet du post #1.
job75 à dit:
Bien sûr il ne faudra pas modifier manuellement la 1ère colonne...
Cliquez pour agrandir...
Pour l'éviter on peut utiliser cette macro qui empêche sa sélection, voyez le fichier joint :
VB: 
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+
 

Pièces jointes

  • Numéros(1).xlsm
    18.2 KB · Affichages: 27
Vote positif 0 Vote négatif
G

GMeunier

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
155
AlCapone
G
  • Question
Microsoft 365 Export données
Réponses
4
Affichages
450
GClaire
G
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
457
GClaire
G
N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
300
NONO14
N
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
158
sebastien176
S
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
18 19 20
Réponses
291
Affichages
67 K
NONO14
N
R
  • Question
Autres Carré magique de bachet avec vba.
Réponses
2
Affichages
537
kiki29
  • Question
XL 2021 Vos avis SVP: Une fonction TRANSPOSE() à améliorer
16 17 18
Réponses
267
Affichages
4 K
p'tit vieux
  • Résolu(e)
XL 2016 Erreur dans code VBA
4 5 6
Réponses
76
Affichages
2 K
patricktoulon
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
279
crocrocro
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…