Copier cellule N fois si cellule = N
Bonjour,
Ce que je voudrais c'est:
Faire la liste avec par exemple pour la première ligne: copier 17 fois: 356 bleu 10cm,
Pour la deuxième ligne: 4 fois: 756 bleu 10cm,
1 fois: 756 bleu 20cm,
Etc, etc...
Je ne sais pas si je suis assez clair.
Si vous avez besoin d'informations en plus dites le moi.
D'avance merci.
Parfait vos deux macros fonctionnent pour moi. Celle de Frangy correspond un peu mieux a ma recherche.
Pourrais-tu m'expliquer comment je peux modifier la macro, si je veux par exemple étendre cette fonction au colonne H, I, J, etc...
(En tout cas, merci pour votre réactivité et vos compétences
Bonsoir,
L'instruction qui indique les colonnes à traiter est :
For Each C In Cel.Offset(0, 2).Resize(, 4)
Exemple
Avec Cel qui représente B2, l'instruction se traduit par "pour chaque cellule de la plage D2:G2".
Pour étendre le traitement aux colonnes H, I, J, tu peux modifier le dimensionnement de la plage :
For Each C In Cel.Offset(0, 2).Resize(, 7)
Autre méthode, sachant que la dernière colonne à traiter est l'avant dernière colonne renseignée, tu peux également coder :
DerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For Each C In Cel.Offset(0, 2).Resize(, DerCol - 4)
(le nombre de colonnes à traiter est donné par DerCol - 4, les 4 colonnes soustraites étant Lieu, Objet, Couleur et Total).
Option Explicit
Sub Creer_Liste()
Dim DerLig As Long, LigneC As Long
Dim Cel As Range, C As Range
Dim i As Integer, DerCol As Integer
LigneC = 2
With Worksheets("Feuil1")
DerLig = .Range("B" & Rows.Count).End(xlUp).Row
DerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For Each Cel In .Range("B2:B" & DerLig)
For Each C In Cel.Offset(0, 2).Resize(, DerCol - 4)
If C.Value > 0 Then
For i = 1 To C.Value
Cel.Resize(, 2).Copy Worksheets("Feuil2").Cells(LigneC, 1)
Worksheets("Feuil2").Cells(LigneC, 3) = .Cells(1, C.Column).Value
LigneC = LigneC + 1
Next i
End If
Next C
Next Cel
End With
Worksheets("Feuil2").Activate
End SubA+