VBA reproduire une macro sur plusieurs lignes avec insertion de lignes

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C

CeDav

XLDnaute Nouveau
Bonjour à tous,
1er post sur le forum !

Bon j'essaie depuis 2 jours ceci :
J'ai un tableau avec 5 lignes de A à K
Je souhaite faire une succession d'action à partir de la ligne 1 (notamment inserer valeur = H1 lignes, puis copier la ligne sur toutes les lignes insérées, puis copier une colonne dans une autre).
Jusque là, j'y arrive avec ma macro ci dessous.
Une cette macro effectuée, je souhaite recommencer sur la ligne qui était au départ la ligne suivante, c'est à dire la ligne 2, puis refaire jusqu'à la dernière ligne.
C'est la que je bloque

ma macro :
Sub InsertionAbo1()
Range("A1").Select
ActiveCell.EntireRow.Resize(rowsize:=Range("H1")).Insert Shift:=xlDown
Rows("11:11").Select
Selection.Copy
Rows("1:10").Select
ActiveSheet.Paste
Range("K1:K11").Select
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("Feuil2").Select
Range("A1:A11").Select
Selection.Copy
Sheets("Feuil1").Select
Range("K1").Select
ActiveSheet.Paste
Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C<52,R[-1]C+1,1)"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A11"), Type:=xlFillDefault
Range("A2:A11").Select
End Sub

Je vous mets le fichiers en pj
Merci d'avance de votre aide
 

Pièces jointes

Trier par date Trier par votes
Bonjour CeDav,

Dans les cas d'ajout ou de suppressions de lignes, il vaut mieux commencer par la fin.

Au départ on a 5 lignes. Si on veut rajouter X lignes après chaque ligne, en commençant par le début, on prend la ligne 1 , on rajoute 2 lignes ; la ligne qui était initialement en 2 se retrouve désormais en 4....

si on commence par la fin, on prend la ligne 5, on rajoute des lignes, on passe à la ligne 4 qui n'a pas changé de place ...
ce qui permet d'utiliser des boucles.

un essai :

Code: 
Sub InsertionAbo1()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
  Next
  .Range("A1").AutoFill Destination:=.Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillSeries
End With
End Sub

A+
 
Vote positif 0 Vote négatif
Bonsoir à tous,

Peut-être ceci :

Code: 
Sub Insertion()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To 65536 Step 11
With Sheets("Feuil1")
If .Cells(i, 1) = "" Then Exit Sub
.Cells(i, 1).EntireRow.Resize(rowsize:=Cells(1, 8)).Insert Shift:=xlDown
.Range(Cells(i + 10, 1), Cells(i + 10, 256)).Copy
.Range(Cells(i, 1), Cells(i + 9, 256)).Select
ActiveSheet.Paste
Sheets("Feuil1").Select
.Range(Cells(i, 11), Cells(i + 10, 11)).Copy
.Cells(i, 9).Select
ActiveSheet.Paste
Sheets("Feuil2").Select
Range("A1:A11").Copy
Sheets("Feuil1").Select
.Cells(i, 11).Select
ActiveSheet.Paste
.Cells(i + 1, 1).FormulaR1C1 = "=IF(R[-1]C<52,R[-1]C+1,1)"
.Cells(i + 1, 1).AutoFill Destination:=Range(Cells(i + 1, 1), Cells(i + 10, 1)), Type:=xlFillDefault
End With
Next i
Application.ScreenUpdating = True
End Sub

bonne nuit !
 

Pièces jointes

Vote positif 0 Vote négatif
re bonjour à tous,

une nouvelle version qui prend en compte le retour de N° à 1 après 52 que j'avais 'zappé'.
Par contre pas compris (et donc pas ajouter) le fait de copier 1/11 en colonne I; si ça marche pour la ligne 1 qui doit être copiée 10 fois (valeur de H1) donc 11 lignes au total, que faire pour la ligne 2 qui doit être copiée 6 fois (H2):
on copie en incrémentant de 1/11 à 7 /11 ou bien 1/7 à 7/7 ??

Code: 
Sub Insertion_V2()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
  Next
    .Range("A2").Formula = "=IF(A1<52,A1+1,1)"
    .Range("A2").AutoFill Destination:=.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Re,

c'est gentil d'aimer mon post 4,mais j'aurais préféré savoir ce qu'il fallait faire pour la colonne I !

Une autre version qui prend en compte la colonne I:
Code: 
Sub Insertion_V3()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
    For j = 1 To .Cells(i, 8) + 1
        .Cells(i + j - 1, 9).NumberFormat = "@"
        .Cells(i + j - 1, 9) = CStr(j & "/" & .Cells(i, 8) + 1)
    Next
  Next
    .Range("A2").Formula = "=IF(A1<52,A1+1,1)"
    .Range("A2").AutoFill Destination:=.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
End With
End Sub

A+
 
Vote positif 0 Vote négatif
Paf à dit:
re bonjour à tous,

une nouvelle version qui prend en compte le retour de N° à 1 après 52 que j'avais 'zappé'.
Par contre pas compris (et donc pas ajouter) le fait de copier 1/11 en colonne I; si ça marche pour la ligne 1 qui doit être copiée 10 fois (valeur de H1) donc 11 lignes au total, que faire pour la ligne 2 qui doit être copiée 6 fois (H2):
on copie en incrémentant de 1/11 à 7 /11 ou bien 1/7 à 7/7 ??

Code: 
Sub Insertion_V2()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
  Next
    .Range("A2").Formula = "=IF(A1<52,A1+1,1)"
    .Range("A2").AutoFill Destination:=.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
End With
End Sub
A+
Cliquez pour agrandir...

Merci beaucoup Paf ! (j'ai bien compris l'idée de partir de la fin, c'est évident quand tu le dis !!)
J'ai effectivement mal présenté les choses pour le 1/x : en fait il faut que ça aille de 1/(Hi+1) à (Hi+1)/(Hi+1)
Un exemple : pour la ligne 2 qui doit être copié 6 fois (H2), on copie en incrémentant de 1/7 à 7/7.

Autre chose, en colonne (A), la numération va en ajoutant +1 à chaque ligne entre (Ai) et (A(Hi+1)).
Un exemple : pour la ligne 2 qui doit être copié 6 fois (H2), si A2=48, alors A3=49, A4=50, A5=51, A6=52, A7=1, A8=2

Merci d'avance
 
Vote positif 0 Vote négatif
Paf à dit:
Re,

c'est gentil d'aimer mon post 4,mais j'aurais préféré savoir ce qu'il fallait faire pour la colonne I !

Une autre version qui prend en compte la colonne I:
Code: 
Sub Insertion_V3()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
    For j = 1 To .Cells(i, 8) + 1
        .Cells(i + j - 1, 9).NumberFormat = "@"
        .Cells(i + j - 1, 9) = CStr(j & "/" & .Cells(i, 8) + 1)
    Next
  Next
    .Range("A2").Formula = "=IF(A1<52,A1+1,1)"
    .Range("A2").AutoFill Destination:=.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row), Type:=xlFillDefault
End With
End Sub

A+
Cliquez pour agrandir...
Désolé je suis un peu lent j'ai aimé avant de commencer à répondre !
Merci pour ton code modifié, ton intuitation était bonne, c'est tout à fait ça.

Reste simplement la numérotation en colonne (A), la numération va en ajoutant +1 à chaque ligne entre (Ai) et (A(Hi+1)).
Un exemple : pour la ligne 2 qui doit être copié 6 fois (H2), si A2=48, alors A3=49, A4=50, A5=51, A6=52, A7=1, A8=2
 
Vote positif 0 Vote négatif
Reste simplement la numérotation en colonne (A), la numération va en ajoutant +1 à chaque ligne entre (Ai) et (A(Hi+1)).
Un exemple : pour la ligne 2 qui doit être copié 6 fois (H2), si A2=48, alors A3=49, A4=50, A5=51, A6=52, A7=1, A8=2
Cliquez pour agrandir...
Bonjour à tous,

Peut-être ceci dont j'ai modifié ma macro Insertion !

bonne journée !
 

Pièces jointes

Vote positif 0 Vote négatif
JBARBE à dit:
Bonjour à tous,

Peut-être ceci dont j'ai modifié ma macro Insertion !

bonne journée !
Cliquez pour agrandir...

Bonjour !
Merci pour votre code du premier post qui marche nickel, sauf qu'il insère toujours 10 lignes c'est à dire toujours la valeur H1, alors qu'il faut insérer pour chaque ligne i, la valeur (Hi). Par exemple : pour la ligne 2 (au début), il faut insérer la valeur (H2).
La macro modifié que vous venez de me renvoyer bloque cf pj.
Merci encore de votre aide
imp ecran macro bloque.jpg
 
Vote positif 0 Vote négatif
JBARBE à dit:
Je ne comprends pas, dans votre exemple il y a bien 10 lignes supplémentaires copiées !
Cliquez pour agrandir...

Oui, parce que la case H1 = 10 !
et pour ligne suivante (ligne 2 au départ, devenue ligne 12), le nombre de ligne à insérer est de 6 (=H2 du départ, devenue H12)

Par ailleurs, comme je l'ai signalé à Pas, j'ai aussi mal présenté les choses pour le 1/x : en fait il faut que ça aille de 1/(Hi+1) à (Hi+1)/(Hi+1)
Un exemple : pour la ligne 2 qui doit être copié 6 fois (H2), on copie en incrémentant de 1/7 à 7/7.

Merci
 
Vote positif 0 Vote négatif
Re,

La dernière version (?),Pour chaque ligne initiale, les ligne ajoutée sont incrémentées par rapport au N° initial, sans pouvoir dépasser 52.

Code: 
Sub Insertion_V4()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    Application.CutCopyMode = False
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
    For j = 1 To .Cells(i, 8) + 1
        .Cells(i + j - 1, 9).NumberFormat = "@"
        .Cells(i + j - 1, 9) = CStr(j & "/" & .Cells(i, 8) + 1)
        If j < .Cells(i, 8) + 1 Then .Cells(i + j, 1).FormulaR1C1 = "=IF(R[-1]C<52,R[-1]C+1,1)"
    Next
  Next
End With
End Sub
A+
 
Vote positif 0 Vote négatif
Paf à dit:
Re,

La dernière version (?),Pour chaque ligne initiale, les ligne ajoutée sont incrémentées par rapport au N° initial, sans pouvoir dépasser 52.

Code: 
Sub Insertion_V4()
With Worksheets("Feuil1") ' à adapter
  For i = 5 To 1 Step -1
    Application.CutCopyMode = False
    .Rows(i).Copy
    .Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
    For j = 1 To .Cells(i, 8) + 1
        .Cells(i + j - 1, 9).NumberFormat = "@"
        .Cells(i + j - 1, 9) = CStr(j & "/" & .Cells(i, 8) + 1)
        If j < .Cells(i, 8) + 1 Then .Cells(i + j, 1).FormulaR1C1 = "=IF(R[-1]C<52,R[-1]C+1,1)"
    Next
  Next
End With
End Sub
A+
Cliquez pour agrandir...

Magnifique !
Enorme merci j'étais arrivé à faire le +1 mais pas à le limiter avec le 52 avec ce code :
Sub Insertion_V5()
With Worksheets("Feuil1") ' à adapter
For i = 5 To 1 Step -1
.Rows(i).Copy
.Rows(i + 1).Resize(rowsize:=.Cells(i, 8)).Insert Shift:=xlDown
For j = 1 To .Cells(i, 8) + 1
.Cells(i + j - 1, 9).NumberFormat = "@"
.Cells(i + j - 1, 9) = CStr(j & "/" & .Cells(i, 8) + 1)
Next
For k = 1 To .Cells(i, 8)
.Cells(i + k, 1) = .Cells(i + k - 1, 1) + 1
Next
Next
End With
End Sub

Mais je me rends compte que je commençais par créer une nouvelle variable alors que je n'en avais pas besoin !
Ton code est élégant et simple, superbe. Et j'ai appris beaucoup. Surtout qu'avec ces codes, c'est comme dans la vie il faut oser ! (et apprendre la langue bien sûr)
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
197
sylvanu
sylvanu
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
50
vazvaz
V
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
455
ph.vanne
ph.vanne
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
348
micie1509
micie1509
Z
  • Question Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
327
zendb
Z
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
550
gui22
G
P
  • Question Question
XL 2021 Ajout/adaptation de code VBA sur feuille qui en contient déjà
Réponses
3
Affichages
71
Pierreavecunp
P
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
545
robpellan52
R
P
  • Question Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
465
mapomme
mapomme
Y
  • Question Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
438
gbinforme
G
J
  • Résolu(e)
Microsoft 365 [RESOLU] VBA boucle, insertion plusieurs lignes, exécution formules, suppression sur si
Réponses
5
Affichages
468
Phil69970
Phil69970
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
379
marie3107
M
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
572
fanou06
F
R
  • Question Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
559
robbynasch
R
Jouxte
  • Question Question
XL 2021 coller une image interne au classeur
2 3
Réponses
33
Affichages
1 K
Jouxte
Jouxte
B
  • Question Question
Microsoft 365 reproduire la mise en forme d'un tableau avec VBA
Réponses
11
Affichages
1 K
BER6543
B
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
Sellig
  • Question Question
XL 2019 Insertion de plusieurs lignes au dessus de la dernière
Réponses
2
Affichages
499
Sellig
Sellig
C
  • Question Question
XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes
Réponses
6
Affichages
613
Cheyenne_2021
C
Retour