Option Explicit
 
Sub CopieFeuilles()
Dim Ws As Worksheet
Dim Wkb As Workbook
    Application.ScreenUpdating = False
    Set Wkb = Workbooks.Add
    For Each Ws In ThisWorkbook.Worksheets
        'Ws.UsedRange.Copy Wkb.ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2)
        'Ws.UsedRange.Copy Wkb.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1)
        Ws.Range("4:" & Ws.Range("A" & Rows.Count).End(xlUp).Row).Copy _
                Wkb.ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2)
    Next Ws
 
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & "Test Concatenation.xls", FileFormat:=xlNormal
    ActiveWindow.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub