Copying data across workbooks in the same folder to masterfile

Hi,

I have multiple excel workbooks that I need to copy into a masterfile within the same folder.

Each workbook would have the same template as the masterfile.

There are 4 sheets in each workbook that need to be transferred specifically to the respective sheet in the masterfile.

I have tried modifying codes such as the one below mentioned, but i can't get it to work.

Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:\Test\"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "TEST.xlsm" Then
Exit Sub
End If

Workbooks.Open (Filepath & MyFile)
Range("A2:D2").Copy
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, 4))


Loop

End Sub

Any help would much appreciated.

Thank you.

I think using the above code to copy a single sheet over but it copies the sheet in the masterfile instead. May I know why?

Hi,

According to forum rules, you must use code tags !

Try to add Activesheet before the Range.Copy …

Hi Marc,

Thanks for the reminder.

The problem was due to the code not being run in a module.

Below is the current code now:

Please Login or Register  to view this content.

Is it possible to copy a range from a specific worksheets in a workbook as paste it in the respective sheets in the masterfile?

As mentioned there a 4 different sheets to the copied and pasted respectively.

E.g.

Workbook1's sheet1's range = Master Workbook's sheet1's next empty row
Workbook1's sheet2's range = Master Workbook's sheet2's next empty row
Workbook1's sheet3's range = Master Workbook's sheet3's next empty row
Workbook1's sheet4's range = Master Workbook's sheet4's next empty row

then it continues to loop through the rest of the files in the folder

thank you

To copy worksheets from MyFile workbook to code workbook :

PHP Code: 

    For N% = 1 To 4
        With ThisWorkbook.Worksheets(N).UsedRange.Rows
            Workbooks(MyFile).Worksheets(N).UsedRange.Copy .Item(.Count).Cells(1)(2)
        End With
    Next 


Do you like it ? So thanks to click on bottom left star icon « Add Reputation » !

hey marc, works great! thank you