XL 2013 [RESOLU] Séparer contenue d'une même cellule et copier la ligne

BENAM69

XLDnaute Occasionnel
Bonjour,

J'ai trouvé pas mal de discussion dans les forums, malheureusement, je n'ai pas réussi 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
 

Pièces jointes

  • Séparation Ligne.xlsb
    12.1 KB · Affichages: 6

vgendron

XLDnaute Barbatruc
Bonjour

il est surement possible de réaliser ce que tu souhaites avec la fonction split
je n'ouvrirai pas ton fichier car il s'agit d'un .xlsb et la dernière fois que j'ai ouvert cette extension, toutes mes options par défaut d'excel ainsi que des éléments du ruban avaient été modifiés..

tu peux surement reposter ton fichier avec les macros au format .xlsm
 

eastwick

XLDnaute Impliqué
Je pense vraiment qu'il faut procéder par étape car si une macro peut résoudre ton problème, elle sera le fruit d'un esprit hyper-calé en VBA !
Voici déjà une méthode de séparation des paquets de caractères à étirer uniquement en fonction de leur nombre.
 

Pièces jointes

  • Copie de Séparation Ligne.xlsb
    13.9 KB · Affichages: 13

BENAM69

XLDnaute Occasionnel
Salut

Je viens d'imbriquer tous ce que j'ai trouvé.
Cela fonctionne comme je le souhaitais.


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

A+

Benam
 
Dernière édition:

vgendron

XLDnaute Barbatruc
Code à mettre dans un module standard
VB:
Sub test()
Dim tablo() As Variant
Dim tablofinal() As Variant

With ActiveSheet
    Fin = .Range("A" & .Rows.Count).End(xlUp).Row
    tablo = .Range("A2:G" & Fin).Value
    Taillefinale = UBound(tablo, 1)
    For i = LBound(tablo, 1) To UBound(tablo, 1)
        If tablo(i, 7) <> "" Then
            Taillefinale = Taillefinale + UBound(Split(tablo(i, 7), ";")) - 1
        End If
    Next i
    ReDim tablofinal(1 To Taillefinale, 1 To 7)
    indFinal = 1
    For indInit = LBound(tablo, 1) To UBound(tablo, 1)
        If tablo(indInit, 7) = "" Then
            For j = 1 To 7
                tablofinal(indFinal, j) = tablo(indInit, j)
            Next j
            indFinal = indFinal + 1
        Else
            nblignes = UBound(Split(tablo(indInit, 7), ";"))
            For k = 0 To nblignes - 1
                For j = 1 To 6
                    tablofinal(indFinal, j) = tablo(indInit, j)
                Next j
                tablofinal(indFinal, 7) = Split(tablo(indInit, 7), ";")(k)
                indFinal = indFinal + 1
            Next k
        End If
       
    Next indInit
   
End With
With Sheets("Result")
    .Range("A2").Resize(UBound(tablofinal, 1), UBound(tablofinal, 2)) = tablofinal
End With
End Sub

et créer une feuille "Result"
 

Discussions similaires

Réponses
22
Affichages
690

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof