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

BENAM69

XLDnaute Junior
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
 

Fichiers joints

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
 

BENAM69

XLDnaute Junior
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

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.
 

Fichiers joints

BENAM69

XLDnaute Junior
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

XLDnaute Impliqué
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

XLDnaute Junior
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:

eastwick

XLDnaute Impliqué
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

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"
 

BENAM69

XLDnaute Junior
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

XLDnaute Junior
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
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas