générer lignes suivant valeur dans cellules

nick774

XLDnaute Nouveau
Dans un but de création d'étiquettes via le publipostage de word, je souhaiterais générer un certains nombres de lignes suivant les valeurs inscrites dans certaines cellules.
Vous pouvez trouver mon exemple ci-joint bien sur...avec un début de macro, mais qui ne me convient pas !
Par exemple pour la 1ere ligne, je génère 2 lignes car 2 produits en taille S, puis je génère 4 lignes car 4 produits en M, etc...
Merci pour votre aide
 

Fichiers joints

BrunoM45

XLDnaute Barbatruc
Re : générer lignes suivant valeur dans cellules

Bonsoir Nick774,

Voici le code
VB:
Option Explicit
Sub report()
  Dim LigD As Long, LigR As Long, Col As Integer
  Dim NbArt As Integer, NumArt As Integer
  Dim Manche As String, Taille As String, Produit As String, Ref As String
  Sheets("Resultat").Cells.ClearContents
  For LigD = 3 To Sheets("donnees").Range("A65536").End(xlUp).Row
    For Col = 3 To 7
      NbArt = Sheets("donnees").Cells(LigD, Col).Value
      For NumArt = 1 To NbArt
      LigR = Sheets("Resultat").Range("B" & Rows.Count).End(xlUp).Row
      Sheets("Resultat").Range("B" & LigR + 1) = Sheets("donnees").Range("A" & LigD)
      ' Taille
      Taille = Sheets("donnees").Cells(2, Col)
      Sheets("Resultat").Range("C" & LigR + 1) = Taille
      ' Couleur
      Sheets("Resultat").Range("D" & LigR + 1) = Sheets("donnees").Range("H" & LigD)
      ' Manche
      Manche = Sheets("donnees").Range("I" & LigD)
      Sheets("Resultat").Range("E" & LigR + 1) = Manche
      ' Produit
      Produit = Sheets("donnees").Range("J" & LigD)
      Sheets("Resultat").Range("F" & LigR + 1) = Produit
      ' Référence
      Ref = Sheets("donnees").Range("K" & LigD) & "/" & Manche & "/" & Taille & "/" & Produit
      Sheets("Resultat").Range("J" & LigR + 1) = Ref
      Next NumArt
    Next Col
  Next LigD
  Sheets("Resultat").Select
End Sub
A+
 

nick774

XLDnaute Nouveau
Re : générer lignes suivant valeur dans cellules

Merci beaucoup Bruno pour ton travail et ta réactivité ! Cela fonctionne à merveille.
Thanks, bonne journée
 

nick774

XLDnaute Nouveau
Re : générer lignes suivant valeur dans cellules

Ah si j'avais une autre question en fait !!! J'ai un souci dans la feuille de résultat, car je souhaiterais rajouter quelques formules dans d'autres colonnes mais si je valide la macro, automatiquement cela m'efface mes formules; y'a t-il moyen de palier à ça?
Merci par avance
 

BrunoM45

XLDnaute Barbatruc
Re : générer lignes suivant valeur dans cellules

Salut Nick774

La ligne fautive est
Code:
Sheets("Resultat").Cells.ClearContents
Qui efface tout le contenu de la feuille

Il faut donc juste mettre les colonnes concernée
Code:
Sheets("Resultat").Range("B:J").ClearContents
Cela effacera uniquement les colonnes B à J

A+
 

nick774

XLDnaute Nouveau
Re : générer lignes suivant valeur dans cellules

Merci Bruno pour ce beau travail.
Bonne journée
 

nick774

XLDnaute Nouveau
Re : générer lignes suivant valeur dans cellules

Bonjour,
Je reviens après quelques jours d'absence suite à un problème de macro. Voici le code qui fonctionne sous Excel 2007 mais qui ne passe pas sous 2003. La ligne d'erreur est celle indiqué en rouge:
Merci par avance pour votre aide
Option Explicit
Sub report()
Dim LigD As Long, LigR As Long, Col As Integer
Dim NbArt As Integer, NumArt As Integer
Dim Manche As String, Taille As String, Produit As String, Composition As String
Sheets("Publipostage").Range("A:F").ClearContents
For LigD = 3 To Sheets("COMMANDE").Range("A65536").End(xlUp).Row
For Col = 4 To 19
NbArt = Sheets("COMMANDE").Cells(LigD, Col).Value
For NumArt = 1 To NbArt
LigR = Sheets("Publipostage").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Publipostage").Range("A" & LigR + 1) = Sheets("COMMANDE").Range("A" & LigD)
' Taille
Taille = Sheets("COMMANDE").Cells(2, Col)
Sheets("Publipostage").Range("C" & LigR + 1) = Taille
' Couleur
Sheets("Publipostage").Range("D" & LigR + 1) = Sheets("COMMANDE").Range("T" & LigD)
' Manche
Manche = Sheets("COMMANDE").Range("U" & LigD)
Sheets("Publipostage").Range("E" & LigR + 1) = Manche
' Produit
Produit = Sheets("COMMANDE").Range("V" & LigD)
Sheets("Publipostage").Range("F" & LigR + 1) = Produit
' Composition
Composition = Sheets("COMMANDE").Range("B" & LigD)
Sheets("Publipostage").Range("B" & LigR + 1) = Composition
Next NumArt
Next Col
Next LigD
Sheets("Publipostage").Select
End Sub
 

BrunoM45

XLDnaute Barbatruc
Re : générer lignes suivant valeur dans cellules

Salut Nick774,

Rien à voir avec la version d'Excel !

La variable NbArt est défini comme Integer
Si la quantité d'article ne contient rien, ou pire du texte alors il y a une erreur

Tu peux palier à ce problème en remplaçant la ligne par
Code:
On Error Resume Next  ' En cas d'erreur on continue le code
NbArt =0 :NbArt = Sheets("COMMANDE").Cells(LigD, Col).Value
On Error Goto 0  ' En cas d'erreur message
A+
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas