Autres Assembler plusieurs fichiers Excel

Sub Combiner_Classeurs()
Dim Chemin$, fn$, n$, t
Dim WB_k As Workbook, rs As Range, rd As Range
Chemin = "C:\Documents\test\"
Set WB_k = ThisWorkbook
fn = Dir(Chemin & "*.xlsx")
Application.ScreenUpdating = False
Do While fn <> ""
    If fn <> WB_k.Name Then
        With Workbooks.Open(Chemin & fn)
        Set rs = Range("A2:F" & [A65536].End(xlUp).Row)
        t = rs.Value
        Set rd = WB_k.Worksheets(1).[A65536].End(xlUp).Offset(1, 0)
        rd.Resize(UBound(t, 1), UBound(t, 2)) = t
        Application.CutCopyMode = False
        .Close False
        End With
    End If
    fn = Dir
Loop
End Sub