lleung89
04-20-2016, 03:02 AM
Hi,
I've got the below macro code that allows me to copy and paste workbooks in a folder location and it copies a labelled worksheet within the workbooks into my current master workbook. I'm having issues in getting the macro to copy the data from the workbooks into the next blank row (some workbooks contain more rows of information than other workbooks.)
Currently the below code just overwrites what's been copied with the newest opened spreadsheet.
i.e I need the code to be able to copy data and then move onto the next line to start the process again
Sub Create_Data()
Dim folderPath As String
Dim fileName As String
Dim thisWorkbook As Workbook
Dim dayNumber As Integer
Dim workbookDate As Date
Dim rowOffset As Long
folderPath = "G:\Z_Non Residential Manual Uploads 16-17"
Set thisWorkbook = ActiveWorkbook
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.xls")
Do While fileName <> ""
Workbooks.Open folderPath & fileName
Sheets("Master Data").Range("A2:O1500").Copy thisWorkbook.Sheets("Sheet1").Range("A2").Offset(rowOffset, 0).End(xlUp).Offset(1)
ActiveWorkbook.Close savechanges:=False
fileName = Dir
Loop
MsgBox "Finished"
End Sub
Any help would be appreciated
I've got the below macro code that allows me to copy and paste workbooks in a folder location and it copies a labelled worksheet within the workbooks into my current master workbook. I'm having issues in getting the macro to copy the data from the workbooks into the next blank row (some workbooks contain more rows of information than other workbooks.)
Currently the below code just overwrites what's been copied with the newest opened spreadsheet.
i.e I need the code to be able to copy data and then move onto the next line to start the process again
Sub Create_Data()
Dim folderPath As String
Dim fileName As String
Dim thisWorkbook As Workbook
Dim dayNumber As Integer
Dim workbookDate As Date
Dim rowOffset As Long
folderPath = "G:\Z_Non Residential Manual Uploads 16-17"
Set thisWorkbook = ActiveWorkbook
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.xls")
Do While fileName <> ""
Workbooks.Open folderPath & fileName
Sheets("Master Data").Range("A2:O1500").Copy thisWorkbook.Sheets("Sheet1").Range("A2").Offset(rowOffset, 0).End(xlUp).Offset(1)
ActiveWorkbook.Close savechanges:=False
fileName = Dir
Loop
MsgBox "Finished"
End Sub
Any help would be appreciated