XL 2013 4 x 1 = 1x4

[atchou]

Bonjour!

À partir de rapport de ventes généré automatiquement par mon CRM, je dois créer un fichier excel afin de créer des étiquettes personnalisées.

Le rapport original me dit, pour chaque facture créée, le nombre de fois qu'un produit a été vendu.

Ex.:

Item Name	Contact Name	Quantity
#1 MOYEN Saucisse de bison aux bleuets	Santa Claus	4

J'aimerais qu'après avoir exécuté une macro, le tableau ressemble à:

Item Name	Contact Name	Quantity
#1 MOYEN Saucisse de bison aux bleuets	Santa Claus	1
#1 MOYEN Saucisse de bison aux bleuets	Santa Claus	1
#1 MOYEN Saucisse de bison aux bleuets	Santa Claus	1
#1 MOYEN Saucisse de bison aux bleuets	Santa Claus	1

* Une fois les lignes copiées, je me fous de la colonne quantité...

* Il faut que les lignes ajoutées s'insèrent à la suite de la ligne et non à la fin du fichier.



Je vous remercie énormément pour votre aide précieuse!

 

[Chris401]

Re : 4 x 1 = 1x4

Bonsoir

Regarde si le fichier te convient

Cordialement
Chris

 

[atchou]

Re : 4 x 1 = 1x4

Salut! Je ne saurais assez te remercier pour ta réponse rapide!!! Je suis TELLLLLLEMENT reconnaissant!

MERCI! MERCI! MERCI!

Et désolé pour le délai de réponse... On a beaucoup de pain sur la planche et je ne peux gérer tous mes dossiers sur une base quotidienne. Mais ce que tu as fait pour moi, c'est EXTRAORDINAIRE!

Merci!

 

[atchou]

Re : 4 x 1 = 1x4

Dernière question:

Voici la macro que tu m'as rédigée:

"Sub Duplique()
Sheets("Resultat").Range("A2:B65536").ClearContents
Dim i As Integer, j As Integer
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Cells(i, 3).Value
Cells(i, 1).Resize(, 2).Copy Sheets("Resultat").Range("A65536").End(xlUp).Offset(1, 0)
Next j
Next i
Sheets("Resultat").Activate
End Sub
"

Tout fonctionne si j'utilise le fichier que tu m'as créé. Cependant, si j'exécute cette macro dans un "vrai" fichier généré par le CRM, j'obtiens une erreur 9 à (Sheets("Resultat").Range("A2:B65536").ClearContents)

J'ai cherché dans les fonctions d'aide et je suis tombé là dessus: Ce lien n'existe plus

Comment pourrais-je modifier ta macro afin de la rendre "universelle", c'est à dire qu'on puisse l'appliquer sur tous les rapports, peu importe l'utilisateur, plutôt que d'avoir à copier-coller les infos dans le fichier que tu m'as si gentiment fait?

Merci encore!

 

[Chris401]

Re : 4 x 1 = 1x4

Bonjour

As-tu bien créé une nouvelle feuille appelée "Resultat" ?

A te relire
Chris

 

[atchou]

Re : 4 x 1 = 1x4

J'ai inséré cette portion avant le script. Si je l'exécute seule, elle fonctionne.

Sub Macro1()
'
' Macro1 Macro
'

'
Sheets.Add After:=ActiveSheet
Sheets("Feuil1").Select
Sheets("Feuil1").Name = "Resultat"
Sheets("Worksheet").Select
Sheets("Worksheet").Name = "Donnees"
End Sub

 

[atchou]

Re : 4 x 1 = 1x4

Petit update: j'ai découvert que si j'exécute ces deux macros séparément, tout fonctionne. Mais pas si je les mets dans le même fichier. J'ai l'impression u'il ne me manque qu'une ligne de code pour que tout fonctionne...

Sub Macro1()
'
' Macro1 Macro
'

'
Sheets.Add After:=ActiveSheet
Sheets("Feuil1").Select
Sheets("Feuil1").Name = "Resultat"
Sheets("Worksheet").Select
Sheets("Worksheet").Name = "Donnees"
End Sub



Sub Duplique()
Sheets("Resultat").Range("A2:B65536").ClearContents
Dim i As Integer, j As Integer
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Cells(i, 3).Value
Cells(i, 1).Resize(, 2).Copy Sheets("Resultat").Range("A65536").End(xlUp).Offset(1, 0)
Next j
Next i
Sheets("Resultat").Activate
End Sub


Merci!

 

[Chris401]

Re : 4 x 1 = 1x4

Bonjour

Ce code vérifie si la feuille "Resultat" existe ; si non, elle est créée

Sub Duplique()

Dim Existe As Boolean
For n = 1 To Sheets.Count
 If Sheets(n).Name = "Resultat" Then
  Existe = True
  Exit For
 End If
Next n

If Not Existe Then
Sheets.Add.Name = "Resultat"
Sheets("Donnees").Range("A1:B1").Copy Sheets("Resultat").Range("A1")
End If

Sheets("Resultat").Range("A2:B65536").ClearContents
Dim i As Integer, j As Integer
With Sheets("Donnees")
For i = 2 To .Range("A65536").End(xlUp).Row
    For j = 1 To .Cells(i, 3).Value
        .Cells(i, 1).Resize(, 2).Copy Sheets("Resultat").Range("A65536").End(xlUp).Offset(1, 0)
    Next j
Next i
End With

Sheets("Resultat").Activate

End Sub

Cordialement
Chris

 

[atchou]

Re : 4 x 1 = 1x4

Merci beaucoup! J'ai réussi!

Je n'ai eu qu'à faire une dernière modification, que je mets ici pour ceux et celles qui verront ce message.

Sub Duplique()

Dim Existe As Boolean
For n = 1 To Sheets.Count
If Sheets(n).Name = "Resultat" Then
Existe = True
Exit For
End If
Next n

If Not Existe Then
Sheets.Add.Name = "Resultat"
Sheets("Worksheet").Range("A1:B1").Copy Sheets("Resultat").Range("A1")
End If

Sheets("Resultat").Range("A2:B65536").ClearContents
Dim i As Integer, j As Integer
With Sheets("Worksheet")
For i = 2 To .Range("A65536").End(xlUp).Row
For j = 1 To .Cells(i, 3).Value
.Cells(i, 1).Resize(, 2).Copy Sheets("Resultat").Range("A65536").End(xlUp).Offset(1, 0)
Next j
Next i
End With

Sheets("Resultat").Activate

End Sub


Encore une fois: merci!

 

[atchou]

Re : 4 x 1 = 1x4

Coucou c'est encore moi!

Mon fichier a changé quelque peu... Et du coup, le script ne fonctionne plus...

Quelqu'un aurait du temps pour réaliser le même objectif avec un peu plus de colonnes?

Merci à l'avance!

 

[Chris401]

Re : 4 x 1 = 1x4

Bonjour

Essaye :

Sub Duplique()
Application.ScreenUpdating = False
Dim Existe As Boolean

For n = 1 To Sheets.Count
If Sheets(n).Name = "Resultat" Then
Existe = True
Exit For
End If
Next n

If Not Existe Then
Sheets.Add.Name = "Resultat"
Sheets("Resultat").Cells.Clear

Sheets("Worksheet").Range("A1:B1").Copy Sheets("Resultat").Range("A1")
End If

Sheets("Resultat").Range("A2:B65536").ClearContents
Dim i As Integer, j As Integer
With Sheets("Worksheet")
.Rows("1:1").Copy Sheets("Resultat").Range("A1")
For i = 2 To .Range("A65536").End(xlUp).Row
For j = 1 To .Cells(i, 5).Value
.Cells(i, 1).Resize(, 10).Copy Sheets("Resultat").Range("A65536").End(xlUp).Offset(1, 0)
Next j
Next i
End With

With Sheets("Resultat")
.Activate
Columns("E:E").Delete Shift:=xlToLeft
End With
End Sub

Cordialement
Chris

 

[mdo100]

Re : 4 x 1 = 1x4

Bonjour atchou, Bonjour Chris401,

Voici votre nouveau fichier modifié sur la base de ce que vous a fait Chris401 .

Le fichier n'a pas un peu changé ce n'est plus du tout le même, je dis ça, j'dis rien !

Bonne journée.

 

[atchou]

Re : 4 x 1 = 1x4

Encore un énorme merci Chris04!

Seulement, j'aurais besoin des autres colonnes. Est-ce possible qu'elles apparaissent dans les résultats?

Excellente journée!

 

[Chris401]

Re : 4 x 1 = 1x4

Bonsoir

Mon code ne supprime que la colonne E (Qtés) - Je suppose que tu as téléchargé le fichier de mdo100 qui lui ne garde que 2 colonnes.

Cordialement
Chris

 

[atchou]

Salut, me revoilà...!

Je change tellement souvent mon fichier, j'en suis gêné de revenir avec un nouveau fichier...

Je me demandais où je pourrais apprendre les notions qui me permettraient d'être autonome sur ce sujet. Je me dis que je pourrais apprendre d'où viennent les "n" et les "j" dans ton script et que je pourrais faire ce que j'ai besoin de faire? Et "dim i as integer", j'imagine que ça veut dire que "i" est écrasée en une ligne et qu'il se suit logiquement et avec des nombres entier?

Ah! Comme j'aimerais être un pro sur excel, trouver des formations bien montées qui me permettraient de faire mes trucs tout seul comme un grand! Les formations sur excel-downloads sont bonnes, mais je n'ai rien trouvé pour me débrouiller dans mon domaine d'activités, soit la production en usine de mets préparés.

P.S. Admettons que ce serait plus simple pour toi de modifier mon fichier, je le joins à nouveau. Le but est toujours le même: transformer les lignes qui ont plus d'un item en plusieurs lignes à un seul item pour en faire des étiquettes.

Merci de tout coeur!