Sub Réorganiser()
Dim Tentrée, Tsortie, T, DL%, N%, i%, ColS%, Colonne%
Tsortie = Split(Sheets("Feuil2").[A2], ",") ' Extraction titres désirés par colonne
Tentrée = Sheets("Feuil1").[A1:EN1] ' Extraction titres BDD exsitante
DL = Sheets("Feuil1").[A1000].End(xlUp).Row ' Dernière ligne à extraire
Sheets("Feuil3").Cells.Clear ' Effacement feuille résultats
ColS = 1 ' N° colonne où coller les infos
For N = 0 To UBound(Tsortie)
Titre = Replace(Tsortie(N), """", ""): Colonne = 0 ' Extraction Titre
For i = 1 To UBound(Tentrée, 2)
If Tentrée(1, i) = Titre Then Colonne = i: Exit For ' Recherche colonne où ce titre est présent
Next i
If Colonne <> 0 Then ' Copie colle de la colonne dans feuille résultats
T = Sheets("Feuil1").Range(Cells(1, Colonne), Cells(DL, Colonne))
Sheets("Feuil3").Cells(1, ColS).Resize(UBound(T, 1), UBound(T, 2)) = T
ColS = ColS + 1 ' Colonne suivante
End If
Next N
Sheets("Feuil3").[1:1].Font.Bold = True ' Titre feuille résultats en gras.
End Sub