Insertion de 3 lignes entre chaque ligne qui copient

Le 31/07/2019 à 10:38

Bonjour à toute la communauté,

Un grand merci de me lire. Voilà le problème que je rencontre.

Je travaille actuellement sur un fichier avec des données par mois que j'ai besoin d'étaler par semaine (en tenant pour fait que les 4 semaines du mois sont égales à la valeur du mois pour faire simple). Pour cela, j'aimerai insérer entre chaque ligne 3 nouvelles lignes qui seront égales à la ligne majeure (le mois) tant que la ligne n'est pas vide.

J'ai commencé par écrire un code pour insérer les 3 lignes entre chaque ligne, mais même ce dernier ne fonctionne pas... (voir ci-dessous). De plus, je pense qu'il est plus simple de créer le code en indiquant toute suite que les 3 lignes insérées doivent correspondre à la ligne majeure (du mois). Je vous mets également ci dessous la forme de mon tableau.

Un grand merci d'avance pour votre aide !

Sub insert_3lignes()

Dim i As Long

Dim LastLine As Long

LastLine = Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To LastLine

ActiveCell.Offset(1, 0).Range("A1").Select

Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

ActiveCell.Offset(3, 0).Range("A1").Select

Next

End Sub

Jan-2012 4491557

Feb-2012 4491226

Mar-2012 4491596

Ce que je souhaite

Jan-2012 4491557

Jan-2012 4491557

Jan-2012 4491557

Jan-2012 4491557

Feb-2012 4491226

Feb-2012 4491226

Feb-2012 4491226

Feb-2012 4491226

Mar-2012 4491596

Mar-2012 4491596

Mar-2012 4491596

Mar-2012 4491596

Le 31/07/2019 à 10:49

Bonjour et sur le forum,

je te propose cette solution qui m'a l'air pas mal (sans vouloir avoir les chevilles qui gonflent )

Sub insert_3lignes()

Dim i As Long
Dim lig As Long
Dim LastLine As Long

LastLine = Cells(Rows.Count, 1).End(xlUp).Row

For i = LastLine To 1 Step -1
    Rows(i & ":" & i).Copy
    Rows(i & ":" & i + 2).Insert shift:=xlDown
    Application.CutCopyMode = False
Next
End Sub

Je parcours le tableau du bas vers le haut, chose qui est souvent faite pour ne pas être embêté par la suppression ou l'ajout de lignes, qui impactent les lignes plus bas

Le 31/07/2019 à 14:00

Hello Ausecour et merci pour ta réponse !

Ca à l'air de marcher mais ça me le fait sur la Sheet2 alors que j'aimerais le faire sur la Sheet3 !

J'ai rajouté au début du code Sheet3.activate mais ça ne fonctionne pas ... Ca continue à le faire sur la Sheet2.... Peut être dois je mettre sheet3.select ?

Merci beaucoup pour ta réponse !

Sub insert_3lignesbis()

Sheet3.Activate

Dim i As Long

Dim lig As Long

Dim LastLine As Long

LastLine = Cells(Rows.Count, 1).End(xlUp).Row

For i = LastLine To 1 Step -1

Rows(i & ":" & i).Copy

Rows(i & ":" & i + 2).Insert shift:=xlDown

Application.CutCopyMode = False

Next

End Sub

Le 31/07/2019 à 14:23

Bonjour,

en effet, essaye plutôt sheet3.select

Rechercher des sujets similaires à "insertion lignes entre chaque ligne qui copient"