Microsoft 365 Problème insersion lignes

[OMMTA]

Bonjour,

Dans un tableau Excel, j’ai une macro qui me permet d’insérer des lignes à la suite d’un tableau.

Problème : comme, sous ce tableau, il y a des lignes masquées (L32 à L36) et que la macro insère des cellules (et non des lignes), quand j’insère plus de 4 lignes, la macro ne fonctionne plus…

Voici la macro :
lgn = Range("Date1").End(xlDown).Row + 1
Range("A" & lgn & ":EE" & lgn).Insert Shift:=xlDown
Range("A" & Range("Date1").Row).EntireRow.Copy
Range("A" & lgn).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A" & lgn) = "Date " & Right(Range("A" & lgn - 1), Len(Range("A" & lgn - 1)) - 5) + 1
Range("A" & lgn).Select

Avec “Date1” qui renvoi sur $A$17

Savez-vous comment régler mon problème ?

Je suppose qu’il vient de la ligne :
Range("A" & lgn & ":EE" & lgn).Insert Shift:=xlDown

Que j’ai essayé de remplacer par :
EntireRow.Insert Shift:=xlDown

Mais cela ne fonctionne pas…

Merci par avance

 

[jmfmarques]

Bonjour
Je n'ouvre jamais les classeurs tiers et n'ai donc pas ouvert le tien.
La lecture du code montré fait apparaître que la détermination de ta variable lgn n'est pas faite par rapport à la dernière cellule remplie, mais par rapport à la première cellule vide de la colonne
Modifie-la ainsi :

lgn = Range("Date1").End(xlUP).Row + 1

Xlup ET NON xlDown

 

[OMMTA]

Merci

En remplaçant uniquement :
lgn = Range("Date1").End(xlDown).Row + 1
par
lgn = Range("Date1").End(xlUP).Row + 1
la macro insère une 1ère ligne sur L5 et la première cellule du tableau est Date 2 (qui existe déjà plus bas, en A18)
Et le bas du tableau descend.
Après 4 lignes insérées, le bouton "+ 1 date" se retrouve sur la L31 et donc fortement réduit
A la 5ème ligne insérée il disparait car L31 n'est pas affichée. C'est ce problème que je décrivais plus haut.

J'ai l'impression que le problème vient plus du fait que la macro insère des cellules et non une ligne.

Je suppose que les lignes qui ne fonctionnent pas sont :
lgn = Range("Date1").End(xlDown).Row + 1
Range("A" & lgn & ":EE" & lgn).Insert Shift:=xlDown
(1)

car seules les cellules de la colonne A à la colonne EE sont copiées et collées.

Il faudrait :
- se mettre sous la dernière cellule du tableau
- insdérer une ligne entière avec quelque chose comme :
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
(2)

Je n'arrive pas à réconcilier la partie (1) et la (2)...

 

[Staple1600]

Bonjour

Affecte cette macro à la place des tiennes aux deux boutons [+ 1 Date]

Sub ajouter_dates()
Dim shp As Shape, R As Range
Set shp = ActiveSheet.Shapes(Application.Caller)
Set R= shp.TopLeftCell.Offset(-1)
If R.Column <> 1 Then Exit Sub
Rows(R.Row).Insert
End Sub

NB: Donc à ne copier qu'une seule fois, la macro servant pour les deux boutons.

Ensuite, il faudra régler le petit souci qui apparaît une fois la ligne insérée.

 

[OMMTA]

@Staple1600

Merci beaucoup
Cette macro insère bien des lignes entières (et non simplement des cellules).

Et comment lier cette macro à mon ancienne, qui insère des lignes mais recopie également le format des cellules A et B et continue le tableau en ajoutant, sous :
Date 10
Date 11
Date 12...

Pour mémoire, ma macro actuelle :
lgn = Range("Date1").End(xlDown).Row + 1
Range("A" & lgn & ":EE" & lgn).Insert Shift:=xlDown
Range("A" & Range("Date1").Row).EntireRow.Copy
Range("A" & lgn).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A" & lgn) = "Date " & Right(Range("A" & lgn - 1), Len(Range("A" & lgn - 1)) - 5) + 1
Range("A" & lgn).Select

et la tête de mon tableau sur lequel on voit le résultat attendu, quand on a inséré une date sous Date10 : sur la ligne 26, on a une nouvelle zone de saisie avec Date 11

 

[OMMTA]

Je crois avoir trouvé :
Dim shp As Shape, R As Range
Set shp = ActiveSheet.Shapes(Application.Caller)
Set R= shp.TopLeftCell.Offset(-1)
If R.Column <> 1 Then Exit Sub
Rows(R.Row).Insert
lgn = Range("Date1").End(xlDown).Row + 1
Range("A" & Range("Date1").Row).EntireRow.Copy
Range("A" & lgn).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
Range("A" & lgn) = "Date " & Right(Range("A" & lgn - 1), Len(Range("A" & lgn - 1)) - 5) + 1
Range("A" & lgn).Select

Qu'en pensez-vous ?
Moyen de simplifier ?

Merci

 

[OMMTA]

Désolé, je n'avais pas lu la fin du message...

Et pendant le confinement, c'est sacrément important la soupe ! encore plus qu'avant (et ça l'était déjà avant).
Alors, un genou à terre, le regard baissé, je te présente mes excuses !
Du coup, je prends l'apéritif ! Ma fille prépare le dîner...

Mon "adaptation" de débutant fonctionne pour le haut du tableau.
Mais pas pour le 2ème bouton (ligne 44). Car ce 2ème bouton ajoute des lignes sous les 2 tableaux !