XL 2019 Dupliquer une selection (ligne) selon la variable d'une cellule

[xfury25]

Bonjour, je viens à vous car je cherche une solution depuis plusieurs jours sur le web sans trouver la solution.
J'aimerais (comme pas mal de sujets sur ce forum) dupliquer une selection (en ligne) sur une autre feuille en fonction d'une variable d'une cellule .
Pour plus de précisions, cela serait pour extraire une feuille qu'un logiciel spécialisé d'étiquettes pourrait lire afin d'imprimer dans les bonnes quantités d'étiquettes.

J'aimerais que mes lignes soit dupliquées dans une autre feuille en fonction du nombre d'étiquettes nécessaire (par ex : ligne A en 3 étiquettes + ligne B en 2 étiquettes + ligne C en 4 étiquettes = 3 lignes A puis 2 lignes B puis 4 lignes C (le tout dans une autre feuille)

J'ai créé un fichier exemple qui illustre mon problème avec le résultat que je cherche dans la deuxième feuille.

Ayant des bases sur Excel mais très peu en VBA, je remercie d'avance toutes les personnes qui m'aideront

 

[Staple1600]

Bonsoir le fil, xfury25

Une petite macro qui fonctionne sur ton fichier exemple
(au préalable, effacer le contenu de la feuille Sortie données, en gardant uniquement la ligne d'entête)
Puis lancer la macro en étant sur la 1ere feuille.

Sub Recopier_Pour_Etiquettes()
Dim NB_ETQ As Range, c As Range, nb&, f As Worksheet: Set f = Sheets("Entrée données")
Set NB_ETQ = f.Range("I3", f.Range("I3").End(xlDown))
For Each c In NB_ETQ
    If IsNumeric(c) Then
    If c.Value > 0 Then
        For nb = 1 To c.Value
        c.EntireRow.Copy _
            Destination:=Sheets("Sortie données").Range("A" & Rows.Count).End(xlUp)(2)
        Next
    End If
    End If
Next
End Sub

 

[xfury25]

Bonsoir le fil, xfury25

Une petite macro qui fonctionne sur ton fichier exemple
(au préalable, effacer le contenu de la feuille Sortie données, en gardant uniquement la ligne d'entête)
Puis lancer la macro en étant sur la 1ere feuille.

Sub Recopier_Pour_Etiquettes()
Dim NB_ETQ As Range, c As Range, nb&, f As Worksheets: Set f = Sheets("Entrée données")
Set NB_ETQ = f.Range("I3", f.Range("I3").End(xlDown))
For Each c In NB_ETQ
    If IsNumeric(c) Then
    If c.Value > 0 Then
        For nb = 1 To c.Value
        c.EntireRow.Copy _
            Destination:=Sheets("Sortie données").Range("A" & Rows.Count).End(xlUp)(2)
        Next
    End If
    End If
Next
End Sub

Bonjour Staple1600,

Merci pour ton aide, quand j'essai d'exécuter la macro en suivant tes instructions, le débogage me trouve une erreur d'execution '13', étant une "incompatibilité de type".
Celui-ci me surligne la ligne :

Dim NB_ETQ As Range, c As Range, nb&, f As Worksheets[B]: Set f = Sheets("Entrée données")[/B]

J'ai essayé de regarder sur le web, mais je n'ai pas trouvé de solution.

 

[Staple1600]

Bonsoir le fil

Aie, Caramba
Mea culpa!
Erreur dans mon copier/coller (en voulant faire plus court)
L'erreur au niveau de la ligne des déclarations de variable.
un s de trop !!!
Voici ce que j'aurais du copier/coller
Dim NB_ETQ As Range, c As Range, nb&, f As Worksheet: Set f = Sheets("Entrée données")
Je te laisse trouver où était le s surnuméraire.


PS: Encore désolé pour ce petit contre-temps.

 

[xfury25]

Bonsoir le fil

Aie, Caramba
Mea culpa!
Erreur dans mon copier/coller (en voulant faire plus court)
L'erreur au niveau de la ligne des déclarations de variable.
un s de trop !!!
Voici ce que j'aurais du copier/coller
Dim NB_ETQ As Range, c As Range, nb&, f As Worksheet: Set f = Sheets("Entrée données")
Je te laisse trouver où était le s surnuméraire.


PS: Encore désolé pour ce petit contre-temps.

Bonsoir,

Le programme fonctionne à merveille, merci énormément pour ton aide précieuse !

Cordialement,
xfury25

 

[Staple1600]

Re

De rien.
It's my pleasure

Et désolé pour la coquille.