Discussion :

[laurianegrange]

Bonjour les pros de la macro,
Je voudrais créer une macro qui vient copier les lignes qui comportent plusieurs numéros de codes produits en dupliquant les autres colonnes de la ligne comme suit :



- Les codes produits font toujours 7 caractères et sont séparés d’un espace
- Les codes doivent être ajoutés les un en dessous des autres : un code par ligne
- Toutes les autres colonnes doivent être copiées
- Le nombre de code produits par cellules varient entre 1 et 100
- La macro devrait fonctionner pour un grand nombre de ligne

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
Sub duppliquerCodesProduits ()
Pour le moment ma macro ne marche pas, pourriez-vous m’aider à la faire fonctionner ?
Dim h as string
Dim i as integer
For j = range(“A65536”)>End(x1up).Row to Step -1
Do while Len(cells(i,4)) > 8
For i = 1 to 100
Value.cells(i,4) = h
Rows(i).InsertShift=x1Down
Rows(i+1).CopyRows(i)
cells(i+1,4)=mid(cells(i,4),7,(len(cells(i,4))-7))
cells(i,4)=left(h(i,8))
i = i+1 
Next
Loop
Next
End Sub ()

exemple court.xlsm

Merci d'avance ))))))))

[Ben_L]

Bonjour,

Essayer le code suivant :

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
Sub duppliquerCodesProduits ()
    Dim i as Integer, j as Integer, n as Integer, tabl as Variant
    Dim Val1 as Variant, Val2 as Variant, Val3 as Variant, Val5 as Variant
    i = 2
    j = 2
    With ThisWorkbook.Sheets("Feuil1")
        Do While .Cells(i, 4).Text <> ""
            Val1 = .Cells(i, 1).Value
            Val2 = .Cells(i, 2).Value
            Val3 = .Cells(i, 3).Value
            Val5 = .Cells(i, 5).Value
            tabl = Split(.cells(i,4).Text, " ")
            With ThisWorkbook.Sheets("Feuil2")
                For n = 0 to UBound(tabl)
                    .Cells(j, 1).Value = Val1
                    .Cells(j, 2).Value = Val2
                    .Cells(j, 3).Value = Val3
                    .Cells(j, 4).Value = tabl(n)
                    .Cells(j, 5).Value = Val5
                    j = j + 1
                Next n
            End With
            i = i + 1
        Loop
    End With
End Sub

Je n'ai pas testé... Et les noms des onglets sont à adapter à votre cas.

[laurianegrange]

Bonjour,

Essayer le code suivant :

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
Sub duppliquerCodesProduits ()
    Dim i as Integer, j as Integer, n as Integer, tabl as Variant
    Dim Val1 as Variant, Val2 as Variant, Val3 as Variant, Val5 as Variant
    i = 2
    j = 2
    With ThisWorkbook.Sheets("Feuil1")
        Do While .Cells(i, 4).Text <> ""
            Val1 = .Cells(i, 1).Value
            Val2 = .Cells(i, 2).Value
            Val3 = .Cells(i, 3).Value
            Val5 = .Cells(i, 5).Value
            tabl = Split(.cells(i,4).Text, " ")
            With ThisWorkbook.Sheets("Feuil2")
                For n = 0 to UBound(tabl)
                    .Cells(j, 1).Value = Val1
                    .Cells(j, 2).Value = Val2
                    .Cells(j, 3).Value = Val3
                    .Cells(j, 4).Value = tabl(n)
                    .Cells(j, 5).Value = Val5
                    j = j + 1
                Next n
            End With
            i = i + 1
        Loop
    End With
End Sub

Je n'ai pas testé... Et les noms des onglets sont à adapter à votre cas.

Bonjour Ben, merci je vais tester votre macro sur mon fichier original. Merci pour votre temps

[Invité]

Bonjour,

Une solution possible sans le formatage des cellules :

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
 
Option Explicit
 
Sub DupliquerLesCodesProduits()
 
Dim ShCible As Worksheet
Dim MonTableau As Variant
Dim I As Long, LigneCible As Long
Dim AireSource As Range, CelluleSource As Range
 
    With Sheets("Sheet1")
         Set AireSource = .Range(.Cells(3, 5), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 5))
    End With
 
    Set ShCible = Sheets.Add(after:=Sheets("Sheet1"))
    With ShCible
      .Range(.Cells(1, 1), .Cells(1, 5)) = Array("Ville", "Pays", "Date", "Codes produits", "Livraison")
      LigneCible = 2
      For Each CelluleSource In AireSource
          MonTableau = Split(CelluleSource, " ")
          For I = LBound(MonTableau) To UBound(MonTableau)
              .Cells(LigneCible, 4) = MonTableau(I)
              .Cells(LigneCible, 1) = CelluleSource.Offset(0, -3)
              .Cells(LigneCible, 2) = CelluleSource.Offset(0, -2)
              .Cells(LigneCible, 3) = CelluleSource.Offset(0, -1)
              .Cells(LigneCible, 5) = CelluleSource.Offset(0, 1)
              LigneCible = LigneCible + 1
          Next I
      Next CelluleSource
    End With
 
    Set AireSource = Nothing
    Set ShCible = Nothing
 
End Sub

[eriiic]

Bonjour,

3e forum... Tu devais être vraiment inquiète de ne pas avoir de réponse.
eric

[Gfacro]

pour votre code du debut



l5 : 1e boucle for, pas de valeur de sortie de boucle
lorsqu'on déclare i comme entier, il est créé à la valeur 0, à la premiere utilisation de i, i n'a pas été initialisé aussi ça fait planter la fonction la ligne 0 n'existe pas.
l7 : vous êtes dans une boucle sur la longueur de la cellule pour savoir s'il reste des codes produits à dupliquer. Vous n'avez pas besoin de la boucle qui plantera de toute façon puisque toutes vos cases n'ont pas le même nombre de code produit -> enlevez votre boucle de la ligne 7. Lorsque vous dupliquez la ligne, la ligne du dessus vous laissez uniquement le code produit, et la ligne du dessous, tout le reste de l'ancienne valeur de la cellule
l8 : vous ne donnez jamais de valeur à h et aura donc toujours la valeur ""
l11 : comme vous avez vidé votre cellule les mids vont planter.
l13 : si vous faites +1 à votre compteur de boucle for, d'un tour sur l'autre il fera +2 en tout.
l15 : c'est wend



Je ne vois rien dans tout cela qui ne puisse être résolu par les messages d'erreur que vous avez en voulant faire tourner votre code et ce qu'une surveillance du code en pas à pas vous apprendrais.
6 erreurs pour si peu de code, je n'ai pas l'impression que vous avez beaucoup cherché, d'avoir passé plus de temps que vous dessus.

[laurianegrange]

pour votre code du debut



l5 : 1e boucle for, pas de valeur de sortie de boucle
lorsqu'on déclare i comme entier, il est créé à la valeur 0, à la premiere utilisation de i, i n'a pas été initialisé aussi ça fait planter la fonction la ligne 0 n'existe pas.
l7 : vous êtes dans une boucle sur la longueur de la cellule pour savoir s'il reste des codes produits à dupliquer. Vous n'avez pas besoin de la boucle qui plantera de toute façon puisque toutes vos cases n'ont pas le même nombre de code produit -> enlevez votre boucle de la ligne 7. Lorsque vous dupliquez la ligne, la ligne du dessus vous laissez uniquement le code produit, et la ligne du dessous, tout le reste de l'ancienne valeur de la cellule
l8 : vous ne donnez jamais de valeur à h et aura donc toujours la valeur ""
l11 : comme vous avez vidé votre cellule les mids vont planter.
l13 : si vous faites +1 à votre compteur de boucle for, d'un tour sur l'autre il fera +2 en tout.
l15 : c'est wend



Je ne vois rien dans tout cela qui ne puisse être résolu par les messages d'erreur que vous avez en voulant faire tourner votre code et ce qu'une surveillance du code en pas à pas vous apprendrais.
6 erreurs pour si peu de code, je n'ai pas l'impression que vous avez beaucoup cherché, d'avoir passé plus de temps que vous dessus.

Je ne suis pas tres a l'aise avec le codage des macros, je vous remercie pour vos remarques et pour le temps que vous y avait passe.

[laurianegrange]

Bonjour,

3e forum... Tu devais être vraiment inquiète de ne pas avoir de réponse.
eric

Haha bien vu! On ne sait jamais sur quel forum on aura une reponse alors j'en ai tente 3.

[laurianegrange]

Bonjour,

Une solution possible sans le formatage des cellules :

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
 
Option Explicit
 
Sub DupliquerLesCodesProduits()
 
Dim ShCible As Worksheet
Dim MonTableau As Variant
Dim I As Long, LigneCible As Long
Dim AireSource As Range, CelluleSource As Range
 
    With Sheets("Sheet1")
         Set AireSource = .Range(.Cells(3, 5), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 5))
    End With
 
    Set ShCible = Sheets.Add(after:=Sheets("Sheet1"))
    With ShCible
      .Range(.Cells(1, 1), .Cells(1, 5)) = Array("Ville", "Pays", "Date", "Codes produits", "Livraison")
      LigneCible = 2
      For Each CelluleSource In AireSource
          MonTableau = Split(CelluleSource, " ")
          For I = LBound(MonTableau) To UBound(MonTableau)
              .Cells(LigneCible, 4) = MonTableau(I)
              .Cells(LigneCible, 1) = CelluleSource.Offset(0, -3)
              .Cells(LigneCible, 2) = CelluleSource.Offset(0, -2)
              .Cells(LigneCible, 3) = CelluleSource.Offset(0, -1)
              .Cells(LigneCible, 5) = CelluleSource.Offset(0, 1)
              LigneCible = LigneCible + 1
          Next I
      Next CelluleSource
    End With
 
    Set AireSource = Nothing
    Set ShCible = Nothing
 
End Sub

Bonjour Eric, la macro me semble bien, le probleme reste que j'ai une trentaine de colonnes dans mon fichier original. Je vais tester votre proposition et la precedente pour voir celle qui s'adapte le mieux. Quoi qu'il en soit, merci pour cette macro !

[Invité]

Pour chaque nouvelle cellule sur l'onglet cible, il suffit de copier les X cellules composant l'enregistrement en cours de la source, à droite de la cellule cible.