Problème pour copié une valeur

Bonjour à tous,

Je tiens à m'excuser d'avance car je ne peux pas vous fournir tous les fichiers car ils sont confidentiels.

Je dois récupérer les 28 commentaires d'un tableur pour les copié dans un tableur pour un récapitulatif.

'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Recapitulatif()
Dim wbRecap As Workbook 'fichier recap
Dim wsRecap As Worksheet 'feuille où on écrit les données
Dim wbSource As Workbook 'fichier à ouvrir
Dim wsSource As Worksheet 'feuille où on cherche les données
Dim DernLign As Integer 'ligne où on écrit les données
Dim vFichiers As Variant 'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range 'plage où on copie les données
Dim Cellules As Range

Set wbRecap = ThisWorkbook 'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets("Recap") 'on écrit dans la feuille 1 du fichier récapitulatif

' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers

' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
Debug.Print "Aucun fichier sélectionné."
MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next

Application.ScreenUpdating = False

' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)

' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~
' C'est ici qu'on écrit les instructions
Set wbSource = Workbooks.Open(vFichiers(k)) 'on ouvre le fichier
'Set Cellules = Range("F2:F2")
'Set Cellules = ActiveSheet.Range("F2:F2")
'Range("D20").Value = Application.WorksheetFunction.Max(Cellules)
Set wsSource = wbSource.Sheets(1) 'On copie les données de la feuille 1
DernLign = wbRecap.Sheets(1).Range("A60000").End(xlUp).Row + 1 'ligne pour écrire le log des fichiers compilés

' - On copie les données vers le fichier Recapitulatif; à adapter
'Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
'rgRecap = wbSource.Name

With wsSource

For l = 1 To 27
rgRecap.Sheets(l + 1).Range("B" & k).Value = .Range("F" & l + 1)
Debug.Print "Q" & l & " " & .Range("F" & l + 1)

Next l

End With

wbSource.Close 'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~
Next k

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean

sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

C'est un code que j'ai récupéré sur un ancien post du forum

J'ai généré un fichier tout bêtes avec les résultats des 28 question que j'affiche avec le Debug.Print

Q1 Bla
Q2 ...
Q3
Q4
Q5 JXXXX
Q6
Q7 vigilance
Q8 Travail
Q9 Horaires
Q10
Q11 veille
Q12
Q13
Q14
Q15 souci bla bla bla
Q16
Q17
Q18
Q19
Q20
Q21
Q22
Q23
Q24
Q25
Q26
Q27 Oui car

Ce que j'aimerais c'est que la Q1 soit copiée dans la feuille Q1 pour l'entretien n°x (le x correspond en gros à la variable k du for To UBound(vFichiers)), La Q2 dans la feuille Q2 pour l'entretien n°x et ainsi de suite.

Je crois que le post où j'ai récupéré le code date un peu donc si vous voyez des modifs je suis preneur

PS : J'utilise ce code car il me permet de ne pas ouvrir les 48 tableurs pour pouvoir pioché les données

Merci bucu et je suis pas très très fort en VBA donc il faut bien me détaillé s'il vous plaît