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

Microsoft 365 Problème insersion lignes

OMMTA

XLDnaute Nouveau
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
 

Pièces jointes

  • Macro4.jpg
    27.5 KB · Affichages: 10
  • Grille à remplir par réceptif V3.8.xlsm
    37.9 KB · Affichages: 3

jmfmarques

XLDnaute Accro
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 :
VB:
lgn = Range("Date1").End(xlUP).Row + 1
Xlup ET NON xlDown
 

OMMTA

XLDnaute Nouveau
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

XLDnaute Barbatruc
Bonjour

Affecte cette macro à la place des tiennes aux deux boutons [+ 1 Date]
VB:
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

XLDnaute Nouveau
@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

XLDnaute Nouveau
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

XLDnaute Nouveau
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 !
 

Discussions similaires

Réponses
12
Affichages
523
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…