XL-2013 : Séparer contenue d'une même cellule et copier la ligne

Bonjour,

J'ai trouvé pas mal de discussion dans les forums, malheureusement, je n'ai pas réussi à trouver une macro qui répond à ce que je recherche.

Sur ma colonne G, j'ai plusieurs valeurs dans une même cellule séparer par des ";". J'ai simplement besoin de les séparer, les coller juste en dessous de la même colonne (donc ajouter une ligne pour chaque valeur) (ex : Si j'ai Valeur1; Valeur2; Valeur3; Valeur4;, il me faudrait ajouter 3 lignes en plus juste en dessous et copier ces trois valeurs les unes après les autres sur la même colonne). Et pour finir, copier coller les informations de la colonne A à F de la lignes traitées sur les mêmes lignes que les valeurs coller précédemment.

C'est-à-dire que pour la Valeur1, Valeur2, Valeur3, Valeur4, les lignes de la colonne A à F sont identiques.

PS : Les valeurs contenues dans la même cellules sont variables, il se peut que j'en ai 2 comme 15 dans la même cellule.

J'espère avoir été claire.

Je vous remercie par avance de votre aide précieuse.

Je vous mets en PJ le fichier

Benam

bonjour,

une proposition

Sub aargh()
    With Sheets("sheet1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = dl To 2 Step -1
            t = .Cells(i, "G")
            If t <> "" Then
                t = Left(t, Len(t) - 1)
                If InStr(t, ";") > 0 Then
                    t = Split(t, "; ")
                    .Rows(i + 1 & ":" & i + UBound(t)).Insert shift:=xlDown
                    .Rows(i).Copy .Rows(i + 1 & ":" & i + UBound(t))
                    .Cells(i, "G").Resize(UBound(t) + 1, 1) = Application.Transpose(t)
                    Else
                    .Cells(i, "G") = t
                End If
            End If
        Next i
    End With
End Sub

Salut h2so4

C'est parfait.

J'ai ajouté un Application.ScreenUpdating = False

pour accélérer la macro.

Merci beaucoup pour ton aide ^^

Namco