Création de lignes et duplications de lignes sous VBA

[Trunksnake]

Bonjour à tous,

Je cherche à dupliquer des lignes un certain nombre de fois suivant des valeurs dans une cellule (dans la colonnes H de mon fichier),
et copier les valeurs de la ligne dupliquée dans les nouvelles lignes créées.
J’ai réussi à créer les lignes et les copier sur la première dupliquée mais pas sur les autres…

fichier.xlsm (41,7 Ko)

Pouvez-vous m’aider ?

[Jacquinot_WILL-FREAD]

Bonjour,
Pouvez-vous nous précisez les feuilles et les lignes à dupliquer ?
Cordialement

[Trunksnake]

Bonjour,

je vous remets le fichier avec une feuille supplémentaire,
celle-ci représente mon souhait final une fois la macro lancée.

La macro travaille sur la feuille « Trame », les lignes à dupliquer sont celles avec un chiffre différent de 0 ou 1 dans la colonne H

fichier.xlsm (50,0 Ko)

Merci d’avance

[Jacquinot_WILL-FREAD]

Bonjour,
Une petite macro à adapter, pour 10 variations.
Convertissez votre tableau en plage avant de l’adapter a votre fichier :

Sub Repetition()
Range("F2").Select

For b = 0 To 10

If ActiveCell > 0 Then
For a = 1 To ActiveCell - 1
Rows(ActiveCell.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(ActiveCell.Row).Copy
Rows(ActiveCell.Row + 1).Select
ActiveSheet.Paste
 Next
 ActiveCell.Offset(1, 5).Select
Else
ActiveCell.Offset(1, 0).Select
End If
 Next
Application.CutCopyMode = False
End Sub

fichier.xlsm (55,1 Ko)
Cordialement
Will-Fread

[Cow18]

@Jacuinot_WILL-FREAD
un boucle en moins et conservations de MFCs

Sub Repetition()
     Set c = Sheets("trame").Range("F" & Rows.Count).End(xlUp)
     Do
            If c.Value > 0 Then
               c.Offset(1).Resize(c.Value).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
               c.EntireRow.Copy
               c.Offset(1).Resize(c.Value).EntireRow.PasteSpecial xlValues
          End If
          Set c = c.Offset(-1)
     Loop While c.Row > 1
     
     Application.CutCopyMode = False
     
     i = c.Offset(Rows.Count - c.Row).End(xlUp).Row - c.Row - 1
     c.Offset(2).Resize(i, 13).FormatConditions.Delete
      c.Offset(1).Resize(, 13).Copy
      c.Offset(2).Resize(i).PasteSpecial xlFormats
End Sub

[Trunksnake]

Bonjour,

merci beaucoup pour votre aide !!
Désolé je n’avais pas vu les réponses…

Cordialement,