Macro pour convertir colonnes en lignes

Bonjour à tous,

J'ai un gros tableau de + 50 000 lignes mais les données disponibles sont rangées d'une manière qui ne m'arrange pas.

Pour résumé, j'ai en colonne A une "clé" et dans les colonnes suivantes (de B à G max, mais pouvant s'arréter avant) des infos que j'aimerai ranger en ligne.

En gros j'ai :

A B C

BLA1 Info1 Info2

et je voudrai :

A B

Bla1 Info1

Bla1 Info2

Avec une macro pouvant traiter plein de lignes

Je mets un fichier d'exmple en pj

Quelqu'un peut-il m'aider ?

Bonsoir,

Tu veux juste doubler le nombre de lignes en fait ?

Bonsoir le fil, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TL As Variant 'déclare la variable TL (Tableau de Ligne)

Set OS = Sheets("Feuil1") 'définit l'onglet source OS
Set OD = Sheets("Feuil2") 'définit l'onglet destination OD
OD.Range("A1").CurrentRegion.ClearContents 'efface d'éventuelles anciennes données dans l'onglet destination OD
TC = OS.Range("A1").CurrentRegion 'définit le tableau de cellules TC
NL = UBound(TC, 1) 'définit le nombre de lignes NL du tableau de cellules TC
For I = 1 To NL 'boucle sur toutes les lignes I du tableau de cellule TC
    'définit la cellule de destination DEST (A1, si A1 est vide, sinon, la première ligne vide de la colonne 1 (=A)) de l'onglet OD
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
    NC = OS.Cells(I, Application.Columns.Count).End(xlToLeft).Column - 1 'définit le nombre de colonnes de la ligne de la boucle
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    TL = OS.Cells(I, 2).Resize(1, NC) 'définit le tableau de la ligne TL (génère une erreur si seule la colonne A contient une donnée)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        GoTo suite: 'va à l'étiquette "suite"
    End If 'fin de la condition
    DEST.Resize(NC, 1).Value = TC(I, 1) 'renvoie dans DEST redimensionnée la valeur ligne I colonne 1 de TC
    DEST.Offset(0, 1).Resize(NC, 1) = Application.Transpose(TL) 'place dans DEST décalée d'une colonne à droite, le tableau TL transposé
suite: 'étiquette
Next I 'prochaine ligne de la boucle
OD.Activate 'active l'onglet destination OD
End Sub

Bonjour,

autre manière (rapide si bcp de données)

Sub Inverser()

Set d = CreateObject("Scripting.Dictionary")

For Each c In [B1:g1].Resize(Application.CountA([a:a]))

If c.Value <> "" Then d(c.Value) = d(c.Value) & Cells(c.Row, 1) & "///"

Next c

ligne = 2

For Each c In d.keys

Cells(ligne, "K") = c

a = Split(d.Item(c), "///")

Cells(ligne, "J") = a

ligne = ligne + 1

Next c

End Sub