Macro does not copy to the next row on the destination sheet

[scassells]

The following code does successfully loop through all of thesheets in the directory however it does not paste to the next open row in thedestination sheet and instead clobbers the data in the same rows

Can you assist?



Sub copydatafrommulttomaster()
Dim folderpath As String, Filepath As String, filename AsString
folderpath = "C:\Users\Stvcass\Documents\AA_HISTORY"
Filepath = folderpath & "*.xls*"
filename = Dir(Filepath)
Do While filename <> ""
If myfile = "activity Log.xlsm" Then
Exit Sub
End If
Workbooks.Open (folderpath & filename)
Application.DisplayAlerts = False
Range("AK4:AT15").Select
Range("AK4:AT15").Copy
'Application.DisplayAlerts = False
Activewookbook.Close
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).Row
ActiveSheet.PasteDestination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow,4))
filename = Dir
Loop
Application.DisplayAlerts = True

End Sub

[mancubus]

welcome to the forum.

try


Sub vbax_63379_copy_paste()

Dim fPath As String, fName As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

fPath = "C:\Users\Stvcass\Documents\AA_HISTORY\" '\ (trailing backslash)
fName = Dir(fPath & "*.xls*")

Do While fName <> "" And fName <> "activity Log.xlsm"
Workbooks.Open (fPath & fName)
ActiveSheet.Range("C1:C7").Copy
ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial
ActiveWorkbook.Close False
fName = Dir
Loop

End Sub