Sub CompilationII()
Dim Temp$, sWBK As Workbook, arTb, x&, y&, dl&
Dim f As Worksheet
Set f = ThisWorkbook.Sheets(1)
Temp = Dir(ActiveWorkbook.Path & "\*.xl*")
'Pour éviter le scintillement pendant la procédure
Application.ScreenUpdating = False
'Pour effacer les lignes avant de les copier.
f.Rows("2:" & Rows.Count).Clear
Do While Temp <> ""
If Temp <> "compil.xlsm" Then
Set sWBK = Workbooks.Open(ActiveWorkbook.Path & "\" & Temp)
With sWBK
With .Sheets(1)
arTb = .Range(.Cells(2, "A"), .Cells(Rows.Count, "K").End(3))
End With
x = UBound(arTb, 1): y = UBound(arTb, 2)
dl = f.Cells(Rows.Count, 1).End(3).Row + 1
f.Range(f.Cells(dl, "A"), f.Cells(dl, "K")).Resize(x, y) = arTb
Erase arTb
.Close False
End With
End If
Temp = Dir
Loop
Application.ScreenUpdating = True
End Sub