Discussion :

[MPackers]

Bonjour à tous,

Je cherche en vain pour le moment à faire fonctionner une boucle...
Voilà le sujet, j'ai dans un premier onglet "Bon de commande" une succession d'articles avec notamment une colonne "quantité sous-ensemble" et une colonne "quantité ensemble".
Je viens via une macro récupérer les informations qui m'intéresse de l'onglet "Bon de commande" vers un onglet "données sources".
Lorsque je lance la macro une fenêtre s'ouvre et je viens sélectionner les articles qui m'intéresse via la colonne "Référence".
L'objectif est d'avoir 1 ligne par article qui se répète les unes sous les autres suivant le nombre indiqué en quantité dans ma colonne "quantité sous-ensemble".
Jusque là pas de soucis, par contre il faut ensuite que j'arrive à répéter encore ce schéma en fonction de la quantité de mon ensemble.
Pour schématiser, si je sélectionne 1 article qui est composé de 5 sous-ensembles, ma ligne va se répéter 5 fois avec une incrémentation allant de 1 jusqu'à 5, par contre si j'ai 2 ensembles de cet article, cela signifie que les lignes doivent répéter 2 fois mes 5 incrémentations. Et c'est la que je plante.
Il ne répète pas uniquement l'article concerné par la quantité de 2 mais bien toutes les références d'articles que j'ai préalablement sélectionné...

Voici le code que j'ai pour le moment.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Recup_art()
 
Dim WsS As Worksheet, WsC As Worksheet
Dim Cel As Range
Dim Cel2 As Range
Dim LigneC As Long
Dim LigneD As Long
Set WsS = Worksheets("Bon de Commande")
Set WsC = Worksheets("Données Sources")
 
On Error Resume Next
Set reponse = Application.InputBox(Prompt:="Veuillez sélectionner une colonne ou des cellules", Type:=8, Default:="")
    If reponse Is Nothing Then Exit Sub
 
Set Plage = reponse
Set Plage1 = reponse.Offset(0, 13)
 
   Application.ScreenUpdating = False
     WsC.Range("A2:K5000").ClearContents
     LigneC = 2
 
      For Each Cel2 In Plage
        If Cel2.Offset(0, 7) > 0 Then
          For Each Cel In Plage
            If Cel.Offset(0, 3) > 0 Then
                Do
                    For i = 1 To Cel.Offset(0, 3)
                        WsC.Cells(LigneC, 1).Value = Cel.Text
                        LigneC = LigneC + 1
                    Next i
                Loop While Cells(Cel, 1) = Cel2.Offset(0, 7)
            End If
          Next Cel
        End If
      Next Cel2

Je joins également un fichier excel pour aider.

J'espère que j'ai pas trop mal expliqué mon problème.
Merci d'avance pour votre aide !!