La fonction "transposé"

[Roblim]

Bonjour,
Je viens solliciter votre aide car je suis en train de tenter de transformer une base de données Excel en un fichier Gedcom pour pouvoir importer dans un outil de généalogie.
J'ai donc un fichier excel avec plus de 10 000 lignes, 4 colonnes et il faut transposer les données dans une seule colonne.
J'ai vu comment faire pour une ligne avec le copier/collerspécial en cochant "transposé".
Mais bien sur je ne peux réitérer cette opération manuellement pour chaque ligne.
Auriez-vous une solution s'il vous plait
Trés cordialement
Robert Costanzo

Je joins le fichier avec l'exemple
Merci de votre aide

 

[Efgé]

Re : La fonction "transposé"

Bonjour Roblim,
Une proposition:

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
[COLOR=blue]Dim[/COLOR] Tablo()
[COLOR=blue]With[/COLOR] Sheets("Feuil2")
    Derligne = .Range("A" & Application.Rows.Count).End(xlUp).Row
    [COLOR=blue]ReDim[/COLOR] Tablo(Derligne * 4)
    k = 0
    [COLOR=blue]For[/COLOR] I = 6 [COLOR=blue]To[/COLOR] Derligne
        [COLOR=blue]For[/COLOR] j = 1 [COLOR=blue]To[/COLOR] 4
            Tablo(k) = .Cells(I, j)
            k = k + 1
        [COLOR=blue]Next[/COLOR] j
    [COLOR=blue]Next[/COLOR] I
[COLOR=blue]End With[/COLOR]
[COLOR=blue]With[/COLOR] Sheets("Feuil3")
    .Range("A1").Resize([COLOR=blue]UBound[/COLOR](Tablo, 1)) = Application.transpose(Tablo)
    .Activate
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Cordialement

 

[Robert]

Re : La fonction "transposé"

Bonjour Roblim, bonjour le forum,

Je n'ai pas compris ta requête. Tu demandes de transposer en une seule colonne :

J'ai donc un fichier excel avec plus de 10 000 lignes, 4 colonnes et il faut transposer les données dans une seule colonne.

puis dans l'exemple tu parles de A1, B1, C1 et D1 ???
L'idéal serait que dans le fichier exemple tu montres dans l'onglet Feuil2 le resultat que tu souhaiterais obtenir.

Édition :

Ooops bonjour Efgé on s'est croisé

 

[Roblim]

Re : La fonction "transposé"

En fichier joint les précisions sur le résultat
Merci pour votre dispo

 

[Efgé]

Re : La fonction "transposé"

Re Roblim, Bonjour Robert,

En fichier joint les précisions sur le résultat

Bhenn, en fait, c'est exactement ma proposition...
Cordialement

 

[Roblim]

Re : La fonction "transposé"

Je vous remercie à tous les 2.
Je testerais et vous tiendrais au courant
Amicalement
Robert

 

[david84]

Re : La fonction "transposé"

Bonjour Roblim, Robert, Efge,
ci-joint proposition par formules.
A+

 

[Roblim]

Re : La fonction "transposé"

Je vous remercie à tous les trois pour votre aide
Cela fonctionne
Toujours de grands spécialistes sur ce forum et une aide appréciable pour le petit utilisateur que je suis
Amicalement
Robert

 

[Roblim]

Re : La fonction "transposé"

Juste une précision complémentaire.
Lorsque dans mon tableau "à transposer" il y a une cellule vide, celle-ci engendre, avec les 2 méthodes proposées, une ligne vide dans la transposition.
Comment adapter le script ou la formule afin que la cellule vide n'engendre pas de ligne vide?
ou
Comment, à partir du résultat, enlever cette ligne en ne changeant rien à l'ordre des autres lignes?

 

[Efgé]

Re : La fonction "transposé"

Re à tous, Bonjour david84,
Une modif (en rouge) pour éviter les cellules vides:

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
[COLOR=blue]Dim[/COLOR] Tablo()
[COLOR=blue]With[/COLOR] Sheets("Feuil2")
    Derligne = .Range("A" & Application.Rows.Count).End(xlUp).Row
    [COLOR=blue]ReDim[/COLOR] Tablo(Derligne * 4)
    k = 0
    [COLOR=blue]For[/COLOR] i = 6 [COLOR=blue]To[/COLOR] Derligne
        [COLOR=blue]For[/COLOR] j = 1 [COLOR=blue]To[/COLOR] 4
            [COLOR=red][B]If .Cells(i, j) <> "" Then Tablo(k) = .Cells(i, j): k = k + 1[/B][/COLOR]
        [COLOR=blue]Next[/COLOR] j
    [COLOR=blue]Next[/COLOR] i
[COLOR=blue]End With[/COLOR]
[COLOR=blue]With[/COLOR] Sheets("Feuil3")
    .Range("A1").Resize([COLOR=blue]UBound[/COLOR](Tablo, 1)) = Application.transpose(Tablo)
    .Activate
[COLOR=blue]End With[/COLOR]
[COLOR=blue]End Sub[/COLOR]

Cordialement

 

[Roblim]

Re : La fonction "transposé"

Merci bien

 

[david84]

Re : La fonction "transposé"

Re,
ci-joint fichier avec utilisation d'une formule empruntée à Tibo😉
Attention, formule matricielle à valider par Ctrl, Maj et entrée.
A+