Mettre plusieurs colonne sur plusieurs lignes

Version imprimable

02/04/2019, 10h40
runner77

1 pièce(s) jointe(s)

Mettre plusieurs colonne sur plusieurs lignes

Bonjour,

J'ai récupérer un export de listing de mail de ma boîte de messagerie.
Le problème c'est qu'il me met l'ensemble de ces mails sur plusieurs colonnes avec parfois plusieurs mails séparé d'une virgule dans une même colonnes.
Et pour pouvoir utiliser au mieux cette liste il me faudrait que chaque mails soit dans une cellule séparé les uns en dessous des autres.
Voici une capture de ce que je souhaiterais faire pour faire plus simple (Un dessin vos mieux que de grand discours).

Pièce jointe 463169

Au début j'avais essayé avec CONCATENER( B1&""&CAR(10)&C1....) cela fonctionnait mais impossible ensuite de re-diviser cette cellule de plusieurs lignes en plusieurs cellules les une en dessous des autres.

Si vous avez des solutions je suis preneur.

Merci par avance

Bonjour,

Voici, à adapter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Extraire()
    Application.ScreenUpdating = False
    Range("B2:B1000").ClearContents
    DerCol = [ZZ2].End(xlToLeft).Column
    DerLig = 2
    For Each cell In Range(Cells(2, "D"), Cells(2, DerCol))
        chaine = cell.Value
        Tbl = Split(chaine, ",")
        For i = 0 To UBound(Tbl)
            Cells(i + DerLig, "B") = LTrim(Tbl(i))
        Next i
        DerLig = [B1000].End(xlUp).Row + 1
    Next
End Sub

Avec le fichier
Pièce jointe 463190

Cdlt

Bonjour

Sur la base (exemple) présenté --->>

Code:

1
2
3
4
5
6
toto = Range("D1").Text
For k = 5 To Cells(1, Columns.Count).End(xlToLeft).Column
  toto = toto & "," & Cells(1, k).Text
Next
titi = Split(toto, ",")
Range("C1:C" & UBound(titi) + 1).Value = Application.Transpose(titi)

03/04/2019, 09h14
runner77

Bonjour,

Merci à vous deux pour vos réponses.
J'ai gardé la première réponse en "stock" car je comprends un peu mieux la logique.
Je suis en train d'essayer de la modifier pour qu'elle le fasse également sur plusieurs lignes le problème c'est que pour l'instant la fonction plante car j'ai plus de 30 000 lignes :roll:

Bonjoiur,

La modif s'il y a plusieurs lignes

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Extraire()
    Application.ScreenUpdating = False
    Range("B2:B1000").ClearContents
    DerCol = [ZZ2].End(xlToLeft).Column
    DerLig = 2
    DerLig_Mails = [D100000].End(xlUp).Row
    For j = 2 To DerLig_Mails
        For Each cell In Range(Cells(j, "D"), Cells(j, DerCol))
            chaine = cell.Value
            Tbl = Split(chaine, ",")
            For i = 0 To UBound(Tbl)
                Cells(i + DerLig, "B") = LTrim(Tbl(i))
            Next i
            DerLig = [B1000].End(xlUp).Row + 1
        Next
    Next j
End Sub

Cdlt

03/04/2019, 14h15
runner77

Merci, je viens de tester mais dans ton exemple c'est plusieurs lignes dans une cellule mois dans mon cas c'est plusieurs ligne dans la feuille de calcul. :mrgreen:
03/04/2019, 14h36
ARTURO83

dans ton exemple c'est plusieurs lignes dans une cellule mois dans mon cas c'est plusieurs ligne dans la feuille de calcul NON , j'ai fais avec plusieurs lignes, voici le fichier en exemple
Pièce jointe 463658
08/04/2019, 07h52
runner77

Bonjour,

Désolé de ne pas avoir répondu plus tôt trop de travail.
J'ai re testé et effectivement cela semble être bon.
Une question qu'elle est la taille max de ligne car la plage Range("B2:B1000").ClearContents est bien trop petite sinon je le ferrais en plusieurs fois.

Merci
08/04/2019, 08h02
ARTURO83

Bonjour,

Mettez la valeur que vous voulez et faites des essais.

Cdlt