Comment faire un copier coller en transposant les données ?

Bonjour,

Le but est d'avoir un fichier Excel nommé « classeur1 » qui récupère toutes les données de plusieurs fichiers excel présents dans un répertoire qui stocke ces fichiers excel (fichier 1 2 3 et 4), le chemin d'accès est connu, ouvre un par un ces fichiers et colle les données de la colonne A du fichier 1 dans le classeur 1 destiné à la récupération de l'ensemble des données.



Exemple : classeur1 ouvert

Clique sur la macro

Ouvre le fichier 1 excel copie la colonne A et la colle en ligne dans la ligne A1 du classeur 1

Puis fermeture du fichier 1

Ouverture du fichier 2 copie la colonne A et la colle en ligne A2 du fichier classeur1 puis ferme le fichier 2 et ainsi desuite

Sub transfert()

Dim Fichier As String, Chemin As String
Dim wb As Workbook

Chemin = "C:\Documents and Settings\Desktop\folder des fichiers excel 1 2 3 4\"

Fichier = Dir(Chemin & "*.xls")

Do While Fichier <> ""

Set wb = Workbooks.Open(Chemin & Fichier)

Const FO = "Liste"
Const FD = "Feuil1"

Const CellD = "A2"
Const CellD2 = "B2"

Dim lifin As Long

Set FDest = ThisWorkbook
Set FPrem = Workbooks.Open(Chemin & Fichier)

lifin = Range("A" & Rows.Count).End(xlUp).Row

'Ce que je souhaite c'est de coller les valeurs en ligne et pas en colonne (transposer)
'et d'incrémenter la ligne à chaque fin de collage pour que la suite des données se mettent au fur et à mesure

FPrem.Sheets(FO).Range("A7:A" & lifin).Copy Workbooks("Classeur1.xls").Sheets(FD).Range(CellD)

FPrem.Close True
Set wb = Nothing
Fichier = Dir
Loop

End Sub