Mettre des colonnes en lignes

Bonjour,

j'ai pour un même classeur plusieurs doc différentes . En faisant un recherche V cela me récupère que la 1ere trouvée .

Je souhaite donc mettre tout en ligne

Passer de :

classeur 1 DOC 1

classeur 1 DOC 2

classeur 1 DOC 3

A dans un autre onglet

Classeur 1 DOC 1 DOC 2 DOC 3

J'ai mis en fichier en exemple avec 2 onglets . j'ai environ 7000 lignes .

Merci d'avance pour votre aide

cdt

Bonjour,

Est-ce qu'une solution par macro conviendrait?

dans ce cas, regarde le fichier joint, et clique sur l'image... (le msgbox qui s'affiche t'informe du temps qu'il a fallu pour dérouler le code...)

Afin de simplifier le code, j'ai effectué un tri de la plage de données dès le début.

si tu ne le souhaites pas, on agira autrement

le résultat à voir dans l'onglet "result"

Le code :

Sub transpose_donnees()
Dim Cel As Range
Dim LeClasseur As Object, LaDoc As Object
Dim FDonnee As Worksheet, FResult As Worksheet
Dim Lig As Long, Nbr As Long, DerLig As Long
Dim It, T
T = Timer
Set FDonnee = Sheets("Initial")
Set FResult = Sheets("result")
Set LeClasseur = CreateObject("Scripting.Dictionary")
Set LaDoc = CreateObject("Scripting.Dictionary")
FResult.Range("A2:IV4000").Clear
With FDonnee
    DerLig = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A1:B" & DerLig).Sort _
        Key1:=.Range("A2"), Order1:=xlAscending, _
        Key2:=.Range("B2"), Order2:=xlAscending, Header:=xlYes
    For Each Cel In .Range("A2:A" & DerLig)
        LeClasseur(Cel.Value) = Cel.Value
    Next Cel
End With
For Each It In LeClasseur.Items
    Lig = Application.Match(It, FDonnee.Columns(1), 0)
    Nbr = Application.CountIf(FDonnee.Columns(1), It)
    For Each Cel In FDonnee.Cells(Lig, 2).Resize(Nbr)
        LaDoc(Cel.Value) = Cel.Value
    Next Cel
    With FResult
        DerLig = .Cells(Rows.Count, "A").End(xlUp).Row + 1
        .Cells(DerLig, 1).Value = It
        .Cells(DerLig, 2).Resize(1, LaDoc.Count) = LaDoc.Items
    End With
    LaDoc.RemoveAll
Next It
FResult.Cells.Columns.AutoFit
MsgBox Timer - T
End Sub

Le fichier :

Alors la Merci Cousinhub , nickel !