Séparer les valeurs et les mettrent à la ligne

Bonjour à tous,

Je sollicite votre aide car je ne trouve pas la solution pour résoudre mon problème malgré mes différentes recherches.

Je possède un tableau ou se trouve les valeurs dans 2 colonnes que je souhaite séparer et les mettre à la ligne avec le rappel de la valeur de la colonne 1 qui sera toujours la même.

Je m'explique :

Format d'origine (Colonne 1 = nom du produit, colonne 2 = lien des images)

Colonne 1 : produit_1.jpg ==> Colonne 2 : produit1_detail1.jpg; produit1_detail2.jpg; produit1_detail3.jpg; produit1_detail4.jpg; produit1_detail5.jpg; produit1_detail6.jpg; etc...

Format souhaité

Colonne 1 : produit1.jpg ==> Coloonne 2: produit1_detail1.jpg;

Colonne 1 : produit1.jpg ==> Coloonne 2: produit1_detail2.jpg;

Colonne 1 : produit1.jpg ==> Coloonne 2: produit1_detail3.jpg

Colonne 1 : produit1.jpg ==> Coloonne 2: produit1_detail4.jpg;

Colonne 1 : produit1.jpg ==> Coloonne 2: produit1_detail5.jpg;

etc.

Remarque :

La colonne 2 possède les liens des images mais pas avec le même nombre de liens, cela dépend des produits, ils y en a qui ont 1 ou 2 lien et d'autre en ont plus.

Voilà, Si quelqu'un peut m'aiguiller pour me donner la marche à suivre ? D'avance merci pour votre aide.

Bonjour Toph,

pourrais tu joindre le fichier Excel dont tu parles (ou un équivalent) à titre d'exemple ?

Merci

Slt Tioum,

Voici le fichier, j'y ai mis juste une 20aine de ligne pour l'alléger.

Merci de t'intéresser à mon problème.

Bonjour,

Essaie avec ce code :

Sub eclate()
Dim Tmp
Dim I As Long
Dim DerLig As Long
Dim Cel As Range
Application.ScreenUpdating = False
DerLig = Cells(Rows.Count, "A").End(xlUp).Row
For I = DerLig To 2 Step -1
    Tmp = Split(Cells(I, 2), ";")
    Cells(I + 1, 1).Resize(UBound(Tmp)).EntireRow.Insert
    Cells(I, 2).Resize(UBound(Tmp) + 1) = Application.Transpose(Tmp)
Next I
For Each Cel In Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
    Cel.Value = Cel.Offset(-1).Value
Next Cel
End Sub

Bonne journée

Slt CousinHub,

Merci c'est parfait, ta macro fonctionne.

Bonne journée à tous.

Oups j'ai eté trop vite,

J'ai une erreur 1004 sur le fichier global ?

Je mets le fichier complet avec les 6800 lignes au cas ou je n'aurais pas vu quelques chose.

Re-,

Quelle ligne du code est surlignée en jaune lors du débogage?

La ligne :

Cells(I + 1, 1).Resize(UBound(Tmp)).EntireRow.Insert

Re-,

Est-ce que tu pourrais mettre un fichier qui reproduit l'erreur?

Oui je l'avez déjà mis juste au dessus, je te le remets c'est le fichier complet avec les 6800 lignes.

Merci

Re-,

Effectivement, je n'avais pas prévu le cas où il n'y aurait qu'une donnée dans la cellule de la colonne B

Essaie avec ce code modifié :

Sub eclate()
Dim Tmp
Dim I As Long
Dim DerLig As Long
Dim Cel As Range
Application.ScreenUpdating = False
DerLig = Cells(Rows.Count, "A").End(xlUp).Row
For I = DerLig To 2 Step -1
    If InStr(1, Cells(I, 2), ";") > 0 Then
        Tmp = Split(Cells(I, 2), ";")
        Cells(I + 1, 1).Resize(UBound(Tmp)).EntireRow.Insert
        Cells(I, 2).Resize(UBound(Tmp) + 1) = Application.Transpose(Tmp)
    End If
Next I
For Each Cel In Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
    Cel.Value = Cel.Offset(-1).Value
Next Cel
End Sub

Bon courage

CousinHub,

Tu as trouvé l'erreur ou une piste ?

Re-,

Euh, tu as lu mon post précédent?

Le code modifié est dedans....

Re,

Un grand merci a toi, effectivement je n'avais pas vu le code modifié.

Le code fonctionne parfaitement. Tu m'enlèves une belle épine du pied.

C'est quel langage ton code, car je suis novice sur excel et j'aimerai approfondir mes connaissances lors de mes moments perdus et ainsi essayer de me former !

Bonne soirée.

Re-,

Ce code s'appelle VBA, pour Visual Basic for Applications...;

C'est un code adapté du Visual Basic, et développé pour les applications Office (Excel, Word....)

Bonne soirée

Ok merci, je vais regarder les tuto d'un peu plus pret.

Juste pour info, pour ton code tout est Ok sauf la première ligne il ne la traite pas, j'ai esayé plusieurs fois mais il ne veut pas la prendre mais c'est juste pour info.

J'ai juste une ligne à modifier sur les plus de 6800, donc je vais pas faire le difficile.

A bientôt et encore merci.

Re-,

Je pensais que tu avais une ligne de titre....

Essaie ainsi :

    Sub eclate()
    Dim Tmp
    Dim I As Long
    Dim DerLig As Long
    Dim Cel As Range
    Application.ScreenUpdating = False
    DerLig = Cells(Rows.Count, "A").End(xlUp).Row
    For I = DerLig To 1 Step -1
        If InStr(1, Cells(I, 2), ";") > 0 Then
            Tmp = Split(Cells(I, 2), ";")
            Cells(I + 1, 1).Resize(UBound(Tmp)).EntireRow.Insert
            Cells(I, 2).Resize(UBound(Tmp) + 1) = Application.Transpose(Tmp)
        End If
    Next I
    For Each Cel In Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
        Cel.Value = Cel.Offset(-1).Value
    Next Cel
    End Sub
     

Mon seigneur est trop bon , je m'en étais accommodé.

Bonne soirée.

Bonjour à tous,

Je déterre mon post, "si cousinhub" est dans le coin, voilà le code fonctionne parfaitement lorsque j'execute la macro. Cependant, si j'ai dans mon tableau plus que 2 colonnes avec la désignation, le prix, etc.. par exemple, la macro me sépare bien le nom des photos et les mets à la ligne mais ne me recopie pas les informations de la ligne.

Hors que dois-je rajouter dans le code, si je veux que lors d'un retour à la ligne après la séparation, les lignes soit complétées automatiquement.

Merci à tous ceux qui se pencheront sur mon probleme.

Rappel du code de la macro créé par "cousinhub" :

        Sub eclate()
        Dim Tmp
        Dim I As Long
        Dim DerLig As Long
        Dim Cel As Range
        Application.ScreenUpdating = False
        DerLig = Cells(Rows.Count, "A").End(xlUp).Row
        For I = DerLig To 1 Step -1
            If InStr(1, Cells(I, 2), ";") > 0 Then
                Tmp = Split(Cells(I, 2), ";")
                Cells(I + 1, 1).Resize(UBound(Tmp)).EntireRow.Insert
                Cells(I, 2).Resize(UBound(Tmp) + 1) = Application.Transpose(Tmp)
            End If
        Next I
        For Each Cel In Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
            Cel.Value = Cel.Offset(-1).Value
        Next Cel
        End Sub
         

Bonjour,

Pourrais-tu mettre un nouveau fichier, avec la structure "exacte" de ton fichier réel? (nb de colonnes, les titres, et quelques exemples anonymes?

@ te relire