copying and data of varying lengths from multiple workbooks and pasting into one worksheet

Hi,

I have multiple workbooks with data (one worksheet in each workbook) that I need to copy and paste into one master workbook on one worksheet. I wrote the following macro and it works, except that every time it pastes, it overwrites the data of the worksheet right before it. Where have I gone wrong?

Sub CopyPaste()
'
' CopyPaste Macro

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "C:\Users\Felicity\Desktop\project\"

Filepath = FolderPath & "*.xls*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 24))

Filename = Dir

Loop
Application.DisplayAlerts = True
End Sub

Thank you for your help! I was able to get this macro to run correctly when attached to the workbook. But if I put it in my personal workbook it doesn't work anymore. So weird!

Sub copypaste()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "\Users\Felicity\Desktop\project\"


Filepath = FolderPath & "*.xls*"


Filename = Dir(Filepath)


Dim lastrow As Long, lastcolumn As Long



Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)


lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close


erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, lastcolumn))




Filename= Dir



Loop
Application.DisplayAlerts = True
End Sub