Insertion des lignes avec une macro

Version imprimable

10/09/2014, 10h25
amapacha

Bonjour,

J'ai une feuille avec 5000 lignes et je voudrais qu'après 21 lignes
6 lignes soient ajoutées si quelqu'un veux bien m'aider.

Merci d'avance

J'ai oublié de preciser que l'action doit se faire tous les 21 lignes de la feuille jusqu'à la fin.

Merci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Macro7()
Dim i As Integer
 
For i = 21 To 5000 Step 21
 
    Rows(i).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(i + 1).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(i + 2).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(i + 3).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(i + 4).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows(i + 5).Select
     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
Next i
 
 
 
End Sub

Bonjour,

Si j'ai bien compris, tu souhaites conserver un "écart" de 21 lignes entre chaque groupe de 6 lignes insérés?

Si c'est le cas, je pense qu'il faut alors (en complément de la réponse de had4789) suivre le nombre de groupes de 6 lignes déjà insérés afin de savoir où insérer le groupe suivant...

Je m'explique:
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Insertion() Dim groupeDe6Lignes As Integer, i As Integer groupeDe6Lignes = 0 For i = 22 To 5000 Step 21 Rows((i + groupeDe6Lignes * 6) & ":" & (i + groupeDe6Lignes * 6) + 6).Select Selection.Insert Shift:=xlDown groupeDe6Lignes = groupeDe6Lignes + 1 Next End Sub
En espérant que cela t'aide

Je vous remercie les gars

Celui ci aussi marche très bien sauf que le code le fait à l'infini
ou peut etre j'etais impatient.

Sinon ça marche et fait bien ce que je voulais.

Merci à vous.:)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub ajoutligne()
 
NbLignes = Range("A1").End(xlDown).Row
multiple = 21
NbAjout = 6
fin = Int(NbLignes / 21)
i = 0
Do
 
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    Rows((multiple + 1) + (multiple + 6) * i).EntireRow.Insert
    NbLignes = NbLignes + 6
    i = i + 1
 
Loop Until i = fin
 
End Sub