XL 2016 [RESOLU] [VBA] Copier une ligne sur base d'une valeur x et coller/insérer x fois en-dessous

[Bichonnet]

Bonjour la commuauté !

Après quelques heures de programmation (qui n'auraient pris que quelques minutes aux membres experts de ce forum - mais il faut bien garder le plaisir de la découverte ), je sèche sur un problème/

But de mon fichier :
Analyser la colonne H, qui reprend des quantités.
- Mon code remplace les vides par des 0 et supprime les lignes avec un 0
- si la quanttié est = 1, rien ne se passe
- si la quantité est > 1 (et on va dire égale à une variable X), le code insère X lignes en-dessous

Cela fonctionne (c'est déjà ça ).

Ma question :
Je voudrais pouvoir copier la ligne où la quantité est >1 et insérer X fois la même lignes en dessous.
en gros plutôt qu'insérer X lignes vide, il faudrait pouvoir insérer X fois un duplicat de la ligne en cours d'analyse.
Je précise que toutes les lignes du tableau (406, valeur figée) sont différentes.

Le code devrait donc partir de la ligne 406 et dès qu'il voit une valeur dans la colonne H qui est >1, copier la ligne et l'insérer X fois en dessous.
Et ainsi de suite jusqu'en haut.


Je pense qu'il ne manque pas grand chose :

Set r = Range("A:H")
    Set count = Range("H:H")
      
    For n = 406 To 4 Step -1
       temp = Range("H" & n) 'prend la valeur de la cellule H
       ' c'est ici que je voudrais pouvoir copier la ligne entière "n" et l'insérer en la dupliquant en dessous.
       ' le code ici insère "temp - 1" ligne en dessous --< il faudrait que ce qu'il insère une copie de la ligne où n>1
        If temp > 1 Then
            Rows(n + 1 & ":" & n + temp - 1).Insert Shift:=xlDown 'insère "temp-1" ligne en dessous de ma ligne n
        End If
    Next n

J'espère que ma question est plus ou moins claire et que quelqu'un pourra m'aider

Merci !

 

[Jacky67]

Bonjour,
Exemple à tester en PJ
​

 

[Bichonnet]

Bonjour Jacky67,

Merci pour ce code très instructif !

J'ai une remarque et deux question s(bien que tout ton code soit une question en soi ;-))
1) Pour l'instant, ce code copie et insère le nombre de lignes qui est inscrit dans la cellule "h".
ce qu'il me faut, c'est qu'au total, j'ai ce nombre de lignes --> il faudrait en insérer "le nombre -1" vu qu'il existe déjà la ligne "cible".
Exemple: si j'ai une valeur dans h=15, je devrais copier et insérer 14 fois la lignes.
UPDATE: c'est bon, ça j'ai modifié en faisant :

If IsNumeric(.Cells(i, "h").Value) And .Cells(i, "h") > 1 Then
      .Rows(.Cells(i, "h").Row).Copy
      .Range(.Rows(.Cells(i + 1, "h").Row), .Rows(.Cells(i + (.Cells(i, "h").Value - 1), "h").Row)).Insert
    End If

2) Dans mon fichier "réel" (que j'ai dû customiser pour éviter de publier certaines données), c'est dans ma colonne I et non H que le nombre est mis.
j'ai du coup modifié ton code (voir ci-dessous) mais cela ne marche pas --> le souci avec "I", c'est que ça se confond facilement avec le... i

Sub inserrer()
Dim i&
With Sheets("offre")
  If .[i1] = "Insertion déjà effectuée" Then
    MsgBox .[i1].Value, , "Information"
    Exit Sub
  End If
  With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
  For i = .Cells(.Rows.count, 1).End(xlUp).Row To 4 Step -1
    If IsNumeric(.Cells(i, "I").Value) And .Cells(i, "I") > 1 Then
      .Rows(.Cells(i, "I").Row).Copy
      .Range(.Rows(.Cells(i + 1, "I").Row), .Rows(.Cells(i + .Cells(i, "I").Value, "I").Row)).Insert
    End If
  Next
  .[i1] = "Insertion déjà effectuée"
End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Le bug est sur la ligne d'insertion --> j'ai remarqué que dans le fichier exemple, ce n'était plus un tableau "Table2".
Dans mon fichier, c'est bien un tableau (et j'en ai besoin vu mon code qui filtre sur base des colonnes du tableau) ==> est-ce que c est la raison pour laquelle il me met l'erreur suivante :
"Run-time error '1004':
This won't work because it would move cells in a table on your worksheet"



3) Si tu devais appliquer ton code dans mon fichier, tu ferais un "Call Inserrer" à la place de mon code qui commence par
Set r=Range("A:I"),... ?

Merci beaucoup pour ton aide !

 

[Jacky67]

Re..
Tester le classeur en Pj

 

[Bichonnet]

terrible !

Un tout grand merci pour la rapidité et le résultat !
Tout fonctionne nickel !

Bonne soirée et...@ bientôt !

 

[Jacky67]

terrible !

Un tout grand merci pour la rapidité et le résultat !
Tout fonctionne nickel !

Bonne soirée et...@ bientôt !

Re..
Petit rajout pour rallonger le tableau"Table2" au cas ou la dernière ligne(colonne i) demande une insertion de ligne