VBA reproduire une macro sur plusieurs lignes avec insertion de lignes

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

  • abo simple.xlsm
    15.3 KB · Affichages: 52
Trier par date Trier par votes
Paf

Paf

XLDnaute Barbatruc
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
JBARBE

JBARBE

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

  • abo simple-1.xlsm
    38.9 KB · Affichages: 44
Vote positif 0 Vote négatif
Paf

Paf

XLDnaute Barbatruc
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
Paf

Paf

XLDnaute Barbatruc
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
C

CeDav

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

CeDav

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

JBARBE

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

  • abo simple-1.xlsm
    44.7 KB · Affichages: 46
Vote positif 0 Vote négatif
C

CeDav

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

CeDav

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

Paf

XLDnaute Barbatruc
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
C

CeDav

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

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
336
ph.vanne
ph.vanne
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
233
micie1509
micie1509
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
493
robpellan52
R
G
  • Résolu(e)
Copie de données d'une feuille à une autre
Réponses
2
Affichages
492
gui22
G
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
389
gbinforme
G
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
523
fanou06
F
B
  • 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
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
813
mouchtre
mouchtre
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne

Membres actuellement en ligne

14 membres et 110 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 650
Messages
2 111 541
Membres
111 199
dernier inscrit
mavoungou regis