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

[BENAM69]

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

 

[vgendron]

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]

Bonjour est-ce que les éléments de la colonnes G ont toujours le même nombre de caractères ?

 

[BENAM69]

O

Bonjour est-ce que les éléments de la colonnes G ont toujours le même nombre de caractères ?

Oui pour le moment c'est que 8 caractères. Mais cela risque de changer mais c'est dans bien longtemps, le temps qu'on arrive avec 9 caractères on sera en 2030 ^^

Merci par avance pour ton aide,

Bien à toi

Benam

 

[eastwick]

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.

 

[BENAM69]

Salut,

Je te remercie pour ton aide, pour les séparations j'ai trouvé la méthode, mais c'est plutôt pour l'automatiser avec un ajout de ligne et copier coller de ses données séparées qui me chiffonne.

Benam

 

[eastwick]

Il faut qu'un XLDnaute méga-barbatruc jette un oeil, pour ma part je reconnais mon incomptétence. C'est trop "chaud" pour moi, surtout sans maîtrise VBA...

 

[BENAM69]

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

 

[eastwick]

Bravo alors !

 

[BENAM69]

Bravo alors !

En tout cas merci. Beaucoup à toi et vgendron d'avoir pris le temps de lire mon post.

A+

Benam

 

[eastwick]

C'est le but de ce forum, on m'a tellement aidé... Si je peux rendre la pareille...
Ca fait plaisir de faire plaisir et ça ne coûte rien si ce n'est qu'un peu de temps.

 

[vgendron]

Code à mettre dans un module standard

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"

 

[BENAM69]

Salut vgendron

Je te remercie pour code. Il fonctionne aussi bien que le mien. C'est toujours bon de savoir une autre façon de le faire.

Merci merci

Benam

 

[BENAM69]

C'est le but de ce forum, on m'a tellement aidé... Si je peux rendre la pareille...
Ca fait plaisir de faire plaisir et ça ne coûte rien si ce n'est qu'un peu de temps.

Re,

Oui tu as raison c'est tellement gentil de la part de toutes ces personnes qui prennent leur temps pour nous aider.
Ils sont géniaux !!!
Benam