Sub test()
Dim i As Byte, DerLig As Long
Sheets(1).[A2].CurrentRegion.ClearContents
For i = 2 To Sheets.Count
DerLig = Sheets(1).Range("A" & Sheets(1).Rows.Count).End(xlUp).Row
Sheets(Sheets(i).Name).[A2].CurrentRegion.Copy Destination:=Sheets(1).Cells(DerLig + 1, 1)
Next i
End Sub