VBA reproduire une macro sur plusieurs lignes avec insertion de lignes

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 !

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

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+
 
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

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+
 
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+
 
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+

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
 
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+
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
 
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
Bonjour à tous,

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

bonne journée !
 

Pièces jointes

Bonjour à tous,

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

bonne journée !

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
 
Je ne comprends pas, dans votre exemple il y a bien 10 lignes supplémentaires copiées !

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
 
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+
 
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+

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)
 
- 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

Réponses
10
Affichages
455
Réponses
1
Affichages
465
Réponses
5
Affichages
379
Retour