OVH Cloud OVH Cloud

Inserer une ligne

2 réponses
Avatar
Comres.metz
Bonjour à toutes et à tous

Voici mon pb.
J'ai un classeur avec 2 onglets ayant chacun un tableau commençant en A4 et
finissant en P? (longueur variable en fonction des onglets).
2 lignes en dessous de la fin de ces tableaux, j'ai un petit tableau
récapitulatif sur 4 colonnes.

Je voudrais pouvoir insérer à partir de la derniere ligne de mon 1er tableau
un nombre de lignes que j'aurais défini dans une cellule sur mon onglet
"page de garde" et ces lignes que je voudrais insérer doivent reprendre les
formules du tableau au dessus.

Ex : sur l'onglet1, mon tableau va de A4 à P20.
Dans Page de Garde, en A5 je rentre 5
Et en cliquant sur mon bouton, mon tableau sur l'onglet A1 se vois rajouter
5 nouvelles lignes, copie de la ligne 20 (mais juste les formules).

Merci d'avance si vous arrivez à me dépatouiller.

2 réponses

Avatar
PMO
Bonjour,

Essayez le code suivant.
ATTENTION faites le test sur une copie de votre classeur.

1) La procédure suivante est à copier dans votre bouton
'**********
Private Sub CommandButton1_Click()
If Not IsNumeric([a5]) Then
MsgBox "La cellule A5 n'est pas un nombre"
Exit Sub
End If
Call PMO_AjoutLigne(CLng([a5]))
End Sub
'**********

2) Copiez la procédure suivante dans un module standard
et adaptez le nom "Feuil1" dans la ligne
Set S = Sheets("Feuil1")
avec le nom de la feuille où figure votre tableau.
'**********
Sub PMO_AjoutLigne(x As Long)
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim last&
if x>50 then exit sub 'limitation à 50
Set S = Sheets("Feuil1")
Set R = S.[a4].CurrentRegion
last& = R.Rows.Count + 3
For i& = 1 To x
S.Rows(last& + 1).Insert Shift:=xlDown
Next i&
S.Select
Set R = S.Range(Cells(last&, 1), _
Cells(last&, R.Columns.Count))
For Each C In R
If C.HasFormula Then
C.AutoFill _
Destination:=Range(C.Resize(x + 1, 1).Address)
End If
Next C
End Sub
'**********

Cordialement.
--
PMO
Patrick Morange



Bonjour à toutes et à tous

Voici mon pb.
J'ai un classeur avec 2 onglets ayant chacun un tableau commençant en A4 et
finissant en P? (longueur variable en fonction des onglets).
2 lignes en dessous de la fin de ces tableaux, j'ai un petit tableau
récapitulatif sur 4 colonnes.

Je voudrais pouvoir insérer à partir de la derniere ligne de mon 1er tableau
un nombre de lignes que j'aurais défini dans une cellule sur mon onglet
"page de garde" et ces lignes que je voudrais insérer doivent reprendre les
formules du tableau au dessus.

Ex : sur l'onglet1, mon tableau va de A4 à P20.
Dans Page de Garde, en A5 je rentre 5
Et en cliquant sur mon bouton, mon tableau sur l'onglet A1 se vois rajouter
5 nouvelles lignes, copie de la ligne 20 (mais juste les formules).

Merci d'avance si vous arrivez à me dépatouiller.





Avatar
Lolo
Bonjour, merci pour votre aide mais cela ne fonctionne pas.
Il n'y a aucune insertion de ligne qui se fait.

J'ai créé un tableau de 5 lignes et de 6 colonnes commençant en A4
En faisant un pas à pas détaillé, il y a bien une boucle qui se fait 6
fois sur : For Each C in R
mais à l'issue, il n'y a pas de lignes supplémentaires.
Si vous pouvez encore m'aider, c'est avec grand plaisir que j'accepte.

Bonjour,

Essayez le code suivant.
ATTENTION faites le test sur une copie de votre classeur.

1) La procédure suivante est à copier dans votre bouton
'**********
Private Sub CommandButton1_Click()
If Not IsNumeric([a5]) Then
MsgBox "La cellule A5 n'est pas un nombre"
Exit Sub
End If
Call PMO_AjoutLigne(CLng([a5]))
End Sub
'**********

2) Copiez la procédure suivante dans un module standard
et adaptez le nom "Feuil1" dans la ligne
Set S = Sheets("Feuil1")
avec le nom de la feuille où figure votre tableau.
'**********
Sub PMO_AjoutLigne(x As Long)
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim last&
if x>50 then exit sub 'limitation à 50
Set S = Sheets("Feuil1")
Set R = S.[a4].CurrentRegion
last& = R.Rows.Count + 3
For i& = 1 To x
S.Rows(last& + 1).Insert Shift:=xlDown
Next i&
S.Select
Set R = S.Range(Cells(last&, 1), _
Cells(last&, R.Columns.Count))
For Each C In R
If C.HasFormula Then
C.AutoFill _
Destination:=Range(C.Resize(x + 1, 1).Address)
End If
Next C
End Sub
'**********

Cordialement.