Macro pour ajout et recopie 1 ligne en bas d'un tableau

Joel50

XLDnaute Nouveau
Bonjour
Sur le fichier joint je souhaiterai créer une macro qui ajoute une ligne en bas d'un tableau et y recopie automatiquement la précédente, sachant que je devrai appliquer cette fonction à plusieurs tableaux de largeurs différentes et y rajouter d'autres colonnes par la suite, la commande ne doit donc pas être limitée en largeur.

Après quelques recherches et l'utilisation de l'enregistreur je suis arrivé à 2 solutions dont aucune ne ma satisfait.
La macro nommée "ajout" me crée bien une ligne en dessous du tableau mais n'agrandit pas le tableau, les formules des autres feuilles basées sur le tableau ne fonctionne plus.
La macro nommée "ajout2" agrandis bien la tableau, par contre étant fixée (je ne sais pas si c'est le bon terme) au lignes 19 et 20, elle ne présente aucun intérêt. De plus elle incrémente automatiquement la date ( et d'autres cellules dont mon tableau sur mon document original) ce que je ne souhaite pas.

La cerise sur le gâteau serait que je puisse saisir automatiquement une date, qui n'est pas forcément la date du jour mais la même pour toutes les feuilles d'un même classeur dans la "colonne A" de toute les lignes qui viennent d'être ajoutés.

Merci de votre aide
Joël
 

Pièces jointes

  • Classeur exemple3.xlsm
    23.3 KB · Affichages: 45

Paf

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Bonsoir

A essayer:

Code:
    Dim Ligne As Long
    Worksheets("Données").Select
    Ligne = Range("b65536").End(xlUp).Row
    Rows(Ligne).Select
    Rows(Ligne).Copy
    Range("A" & Ligne + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

à adapter pour la feuille "Données2"

Bonne suite
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Bonjour
Merci de la réponse.
La macro, beaucoup plus sobre que la mienne, ajoute bien une ligne en dessous du tableau mais n'étant pas le tableau.

J'ai essayer en lui ajoutant: ActiveSheet.ListObjects("Tab_Données3").Resize Range("$A$8:$G$21") pour étendre mon tableau, ça fonctionne mais de manière non dynamique, uniquement pour la ligne 21.

ActiveSheet.ListObjects("Tab_Données3").Resize Range("b65536") ne fonctionne pas

Joël
 

job75

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Bonjour Joel50, Paf, Jean-Marie,

Je ne comprends pas trop pourquoi vous voulez insérer des lignes.

Vos tableaux sont organisés en tableaux Excel, ce qui évite justement de faire cette opération.

Il suffit d'entrer une donnée dans la 1ère ligne vide pour que les formats et les formules de la ligne du dessus soient copiés.

A+
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Bonjour
Merci

Staple1600, ou doit je mettre cette ligne dans le code, quelque soit l'endroit ou je le met, il bloque l'exécution de la macro.

Job75
Tout à fait d'accord pour les tableaux Excel qui sont un super outils. Par contre, ils fonctionnent parfaitement si j'entre manuellement une donnée en bas de tableau, mais ne fonctionne pas si cette ligne est ajoutée à partir d'une macro (ou je n'ai pas le bon code, ce qui est certainement plus probable au vu de mes difficultés en programmation)

Joël
 

Pièces jointes

  • Classeur exemple4.xlsm
    24.8 KB · Affichages: 38
  • Classeur exemple4.xlsm
    24.8 KB · Affichages: 47
  • Classeur exemple4.xlsm
    24.8 KB · Affichages: 50

job75

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

ils fonctionnent parfaitement si j'entre manuellement une donnée en bas de tableau, mais ne fonctionne pas si cette ligne est ajoutée à partir d'une macro

Vous êtes têtu, il n'y a pas besoin de macro !

Maintenant si vous en voulez une à tout prix :

Code:
Sub ajout()
With Sheets("Données").Range("A65536").End(xlUp)
  .Cells(2) = .Cells + 1 'jour suivant
  Application.Goto .Cells(2)
End With
End Sub
A+
 

Staple1600

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re, Bonjour job75

Staple1600, ou doit je mettre cette ligne dans le code, quelque soit l'endroit ou je le met, il bloque l'exécution de la macro.
Sur mon PC, cela fonctionne (avec le code dans un module standard)
Bien sur il faut que le nom du tableau soit valide et qu'il existe donc sur la feuille concernée.

Dans ton message, tu disais Tab_Données3
Donc ma ligne de code se base sur ce nom Tab_Données3

Question: Comment se nomme ton tableau sur le fichier Excel de ton PC ?
 

job75

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re,

Je suis sur Excel 2010 mais je me souviens que sur Excel 2003 End(xlUp) ne donne pas toujours la dernière ligne du tableau Excel.

Testez donc aussi :

Code:
Sub ajout1()
With Sheets("Données").Range("A" & Application.Match(9 ^ 9, Sheets("Données").[A:A]))
  .Cells(2) = .Cells + 1 'jour suivant
  Application.Goto .Cells(2)
End With
End Sub
Et ceci est encore mieux si l'on déplace le tableau :

Code:
Sub ajout2()
With Sheets("Données").ListObjects(1).Range
  .Cells(.Rows.Count + 1, 1) = .Cells(.Rows.Count, 1) + 1 'jour suivant
  Application.Goto .Cells(.Rows.Count + 1, 1)
End With
End Sub
A+
 

job75

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re,

Le code de Staple1600 fonctionne très bien comme ceci :

Code:
Sub ajout()
With Sheets("Données").ListObjects(1)
  .ListRows.Add AlwaysInsert:=True
  Application.Goto .Range.Cells(.Range.Rows.Count, 1)
End With
End Sub
On entre alors la date que l'on veut.

A+
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

RE
Job75
Effectivement, je suis relativement têtu, bon diagnostic pour cette partie ;)
Par contre, mon tableau initial que je ne souhaite pas mettre en ligne (je peux l'envoyer en MP) comporte 5 feuilles de données avec chacune de 20 à 100 colonnes (pour des questions de pratique et de facilité de modification, je ne souhaite tout mettre sur le même feuille). Ces feuilles sont alimentées par des formulaires, cependant vu la nombre de données, je souhaiterai créer une macro est de recopier la dernière ligne dans chacune des feuilles et ensuite de modifier les dates en une fois (ce n'est pas forcement J+1, mais de + 30 à + 90 jours) .
Le dernier code ajoute bien une ligne au tableau, mais vierge avec juste la date.

Ensuite, et là, j'aurai encore besoins de secours, une fois remplies, je souhaite pouvoir avec un combobox "date", modifier quelques données avec de mes formulaires. Je n'ai toujours pas trouvé comment recharger les données d'un formulaire dans mes userform, pour les modifier et les recharger.

Staple1600
Bon diagnostic également, il y avait confusion entre les tableaux des feuille donnée 1 et 2.
Ca marche, ne me reste plus pour cette partie à trouver comment modifier les dates de la ligne ajoutée, et j'aurai fait un pas de plus.

Je précise, s'il en était nécessaire, que je n'ai jamais suivi de cours d'informatique, pas plus que de programmation, J'arrive a me débrouiller en excel, par contre beaucoup plus de mal en VBA.

Je me débrouille avec les recherche sur Internet et l'aide de personnes comme vous, alors encore un grand MERCI.
Joël
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re
Pas de surprise sur le fait que vous soyez beaucoup plus rapide que moi, j'ai des réponses avant d'avoir fini de tester et poser mes questions
Je regarde les derniers code et je vous tiens au courant.
Et en plus, même sur la version Excel, je me suit planté, c'est pas 2003 mais 2013....
 

Staple1600

XLDnaute Barbatruc
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re


Une variante de mon code précédemment Jobelisé ;)
Code vb:
Sub ajoutBis()
With ActiveSheet.ListObjects("Tableau1")
.ListRows.Add AlwaysInsert:=True
'sélection dernière ligne
.ListRows(.DataBodyRange.Rows.Count).Range.Select
'sélection première cellule , dernière ligne
.ListRows(.DataBodyRange.Rows.Count).Range.Range("A1").Select
End With
End Sub
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re
ce code fonctionne:
Dim Ligne As Long
Worksheets("Données").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Tab_Données").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Je vais essayer de l'appliquer sur plusieurs feuilles.
Les autres permettent bien d'ajouter la ligne de tableau en bas , il faudrait que je leur ajoute la partie pour copier la ligne. J'ai voulu faire d'autre chose en même temps et là j'y perd un peu (beaucoup) mon latin, je décroche, même le simple devient compliqué.
Joël
 

Joel50

XLDnaute Nouveau
Re : Macro pour ajout et recopie 1 ligne en bas d'un tableau

Re
Voila une copie du code qui fonctionne (avec les 5 feuilles de mon tableau)
Je voulez aussi préciser, ça a peut être son importance que je créer mon fichier sur un PC fixe (I3 avec 4 Go de ram) et que je l'utilise sur un combiné tablette/PC (Asus TF810c) beaucoup moins puisant et qui traite bien moins rapidement le travail.
Peut être y a t il une solution simple pour rendre le tout plus fluide.
Le code:
Sub Macro1()
'
' Macro1 Macro
'
' Touche de raccourci du clavier: Ctrl+a
'
Dim Ligne As Long

Worksheets("Data_Système").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Données_Système").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Worksheets("Data_lait").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Données_Lait").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Worksheets("Data_Troupeau").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Données_troupeau").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Worksheets("Data_Ration").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Données_Ration").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

Worksheets("Data_Compta").Select
Ligne = Range("b65536").End(xlUp).Row
ActiveSheet.ListObjects("Données_Compta").ListRows.Add AlwaysInsert:=True
Rows(Ligne).Select
Rows(Ligne).Copy
Range("A" & Ligne + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

End Sub

Joël
 

Discussions similaires

Statistiques des forums

Discussions
312 310
Messages
2 087 120
Membres
103 479
dernier inscrit
Compta