Insertion automatique de lignes

[Ity]

Bonjour,
Je débute en VBA...et j'ai un petit souci !!!
Je souhaite insérer automatiquement 4 lignes en dessous de chaque ligne selectionnée... Ci dessous, le code dans lequel il manque qqch pour qu'il fonctionne correctement...Si je selectionne 1 ligne, la macro insere bien 4 lignes en doussous...Mais si je selectionne 2 lignes, la macro en insere 8...Le tableau que je dois modifier contient près de 10000 lignes et si je dois répéter la macro à chaque ligne selectionnée une à une, j'en ai pour des heures...
L'aide de la communauté d'Excel Downloads sera la bienvenue !!!!!


Sub Macro3()
'
' Macro3 Macro
' Macro enregistrée le 07/06/2005 par Ity
'

'
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
End Sub

 

[le Fnake]

Bonjour Ity, le forum

L'idée consisterait à parcourir toutes les lignes en commencant par le bas : tu prends la dernière ligne, t'en rajoutes 4, tu prends celle du dessus et tu continue et hop le tour est joué
Par contre, le code va inserer 4 lignes pour toutes les lignes, mais si tu veux faire ceci que pour certaines lignes que tu as choisi, il faudra alors procéder autrement...

Sub Insert4Lignes()

derligne = Range('Feuil1!A1').End(xlDown).Row
For i = 4 To 1 Step -1
    Range('A' & i + 1).EntireRow.Insert
    Range('A' & i + 1).EntireRow.Insert
    Range('A' & i + 1).EntireRow.Insert
    Range('A' & i + 1).EntireRow.Insert
Next

End Sub

Bon courage

 

[PascalXLD]

Bonjour

essaies ceci

Sub Macro1()
Dim x As Integer
For x = Range('A65536').End(xlUp).Row To 1 Step -1
If Not Intersect(Range('A' & x), Selection) Is Nothing Then
Rows(x).Insert Shift:=xlDown
Rows(x).Insert Shift:=xlDown
Rows(x).Insert Shift:=xlDown
Rows(x).Insert Shift:=xlDown
End If
Next
End Sub

Bon courage

 

[Ity]

Un grand merci à Pascal76 et Le Fnake pour votre aide !!!
A vous 2 plus quelques autres recherches sur le web j'ai abouti à ce code qui correspond à mes attentes !
Bravo pour votre réativité et encore merci !


Sub Insertion4lignes()
'
' Insertion4lignes Macro
' Macro enregistrée le 07/06/2005 par Ity
'
For i = [a65536].End(xlUp).Row To 2 Step -1
Rows(i).Insert
Rows(i).Insert
Rows(i).Insert
Rows(i).Insert
Next

'
End Sub

 

[PascalXLD]

Euh

Excuse moi Ity Mais le code que tu donnes ne correspond pas à ta demande initiale qui était d'insérer des lignes en dessous de chaque ligne selectionnée

Là ce code t'insère des lignes à chaque ligne

M'enfin si cela te convient

Bonne journée

 

[Ity]

Oui, tu as raison...Je suis parti du principe que le tableau contenait les valeurs dans des cellules consécutives et qu'insérer des lignes entre 2 lignes vides ne me dérangeait pas...Mais je vais qd même me repencher sur le problème...Merci de ta remarque, et cela prouve que je suis nul en VBA !!

 

[Ity]

Pascal76, ton code est nettement plus pertinant que le mien dans le sens où il est plus souple. Je te remercie de ta remarque qui m' a permis de corriger le tir !
Bonne fin de journée à tous et à toutes.