Option Explicit
Sub test()
Dim Fso As Object, MonRepertoire As String, derlig As Long
Dim f1 As Object, f2 As Object, wb As Workbook
Set Fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "C:\repD\" 'Ne pas ajouter le dossier qui contient les classeurs
Application.ScreenUpdating = False
For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
For Each f2 In f1.Files
Set wb = Workbooks.Open(f2)
With wb.Sheets(1)
derlig = .Range("a" & Rows.Count).end (xlUp).Row
.Range("bv2:cc" & derlig).Copy ThisWorkbook.Sheets("Full").Range("a" & Rows.Count).End(xlUp)(2)
End With
wb.Close False
Next f2
Next f1
ThisWorkbook.Save
End Sub