Macro pour publipostage, copier ligne en fonction d'une valeur

Bonjour à tous,

Je me permets de poster une question sur ce forum car je bloque sur le développement d'un macro vba.

Je suis en train de lancer mon entreprise de vente de pantoufles et je dois créer un publipostage (word/excel) pour créer des étiquettes que j'irais coller sur mes boites de pantoufles. Jusque là pas de problème il y'a beaucoup d'informations sur internet.

Mais maintenant je n'arrive plus à avancer. En effet dans le fichier ci-joint : https://www.cjoint.com/c/HDkoJVZmbgT

-Il y'a dans la première feuille, les commandes que j'ai passé à mes fournisseurs (modèle, couleur & pointure)

Ensuite dans la deuxième feuille j'aimerais réussir à créer une macro me permettant d'aller copier les informations de la première en fonction du nombre de modèle que j'ai par pointure.

Par exemple :

Référence/Couleur/35/36/37

3086 / Rouge / 3/ 6 / 12==> dans la première feuille

Devrait arriver dans la deuxième feuille :

Ref3086 / Rouge / 35

Ref3086 / Rouge / 35

Ref3086/ Rouge / 35

Ref3086/Rouge /36

... 6 fois

Pour le 37, 12 fois

Etc

Me permettant ainsi de faire mon publipostage.

Si quelqu'un pourrais juste m'aiguiller sur la bonne voie, j'ai essayé avec l'écriture automatique de macro mais je n'arrive avec les bonnes boucles à tomber sur mes pieds.

Merci d'avance, j'espère que ma demande pourra trouver une aide.

Bonne journée à tous.

Bonjour,

tu as besoin de la fonction vba Split() qui découpe ton texte avec un "délimiteur" ,

pour toi , c'est "/"

avec : Data = "3086 / Rouge / 3/ 6 / 12"

la formule "façon 1"

Valeur36 = Val( Split( Data , "/" )(2) )

Valeur37 = Val( Split( Data , "/" )(3) )

Valeur38 = Val( Split( Data , "/" )(4) )

la formule "façon 2"

TabElement = Split( Data , "/" )

résultat :

TabElement(0) = "3086"

TabElement(1) = "Rouge"

TabElement(2) = "3"

TabElement(3) = "6"

TabElement(4) = "12"

en complément , tu as

Trim() qui supprime les espaces devant / derrière

Val() qui transforme le texte "3" en valeur 3

déclare ton tableau : Dim TabElement(20) as string

pour 0 à 4 ce serait TabElement(5) , mais tu peux prévoir large

@+JP

Bonjour JP,

Merci pour ta réponse, cependant j'ai mis les "/" pour mettre un exemple sur la discussion sans que vous ayez besoin d'ouvrir le fichier excel que j'ai uploadé.

En effet mes informations sont contenues dans des cellules différentes.

Désolé pour le dérangement.

Bonjour,

c'est quel "bout" de code qui te bloque ?

@+JP

Sub Macro3()
Dim i As Integer
Dim x As Integer
Dim j As Integer
Dim col As Integer
Dim z As Integer

With ActiveSheet
Sheets("Feuil1").Select
x = .Cells(.Rows.Count, 1).End(xlUp).Row
Endcol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column

For col = 3 To Endcol
For i = 2 To x

j = .Cells(i, col)

For z = 1 To j

Range("A" & i & ":B" & i).Select
    Selection.Copy

    Sheets("Feuil3").Select
    Range("A" & i).Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Cells(1, col).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil3").Select
    Range("C" & i).Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select

   Next z

Next i
Next col

End With
End Sub

Voilà où j'en suis c'est vraiment nul

Range("A" & i & ":B" & i).Select

Selection.Copy

Sheets("Feuil3").Select

If Not IsEmpty(Range("A" & i)) Then

Range("A" & i + 1).Select

Else

Range("A" & i).Select

End If

ActiveSheet.Paste

Sheets("Feuil1").Select

Cells(1, col).Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Feuil3").Select

If Not IsEmpty(Range("C" & i)) Then

Range("C" & i + 1).Select

Else

Range("C" & i).Select

End If

ActiveSheet.Paste

Sheets("Feuil1").Select

J'ai ajouté une fonction If qui m'a débloqué un petit peu

Voilà après un test le code marche bien que celui là ne soit pas très beau je pense, si jamais vous avez des améliorations à me suggérer je suis preneur.

Sub Macro3()
Dim i As Integer
Dim x As Integer
Dim j As Integer
Dim col As Integer
Dim z As Integer

With ActiveSheet
Sheets("Feuil1").Select
x = .Cells(.Rows.Count, 1).End(xlUp).Row
Endcol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column

For i = 2 To x

For col = 3 To Endcol

j = .Cells(i, col)

For z = 1 To j

Range("A" & i & ":B" & i).Select
    Selection.Copy

    Sheets("Feuil3").Select

    PremLigVide = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1

    Range("A" & PremLigVide).Select
    ActiveSheet.Paste

    Sheets("Feuil1").Select

    Cells(1, col).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil3").Select

    Range("C" & PremLigVide).Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select

   Next z

Next col

Next i

End With
End Sub

Bonjour,

il n'y a pas de code null

il y a des codes à améliorer , coté visibilité , coté rapidité,...

au départ tu écris ton code pour que çà fonctionne et après tu recodes...

pour le code suivant , j'ai testé un mini code pour savoir si c'était ok ...

à toi de faire pareil , tester des tout petit bout de code

en premier et c'est important évite au max les active.... et les select...

pour ton code

Range("A" & i & ":B" & i).Select
    Selection.Copy

    Sheets("Feuil3").Select
    Range("A" & i).Select
    ActiveSheet.Paste

tu peux écrire ou tester : Sheets("Feuil3").Range("A" & i & ":B" & i).Value = Sheets("Feuil1").Range("A" & i & ":B" & i).Value

et aussi

x = .Cells(.Rows.Count, 1).End(xlUp).Row
Endcol = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column

EndLig = Sheets("Feuil1").Cells(.Rows.Count, 1).End(xlUp).Row
EndCol = Sheets("Feuil1").Cells(1, Cells.Columns.Count).End(xlToLeft).Column

@+JP