Hi all,
I am trying to transfer several rows (there isnt specific number of rows) from column J from several worksheet saved in my C drive in a folder named "inventory" into my master sheet. I have little knowledge in vba. I have the following code. However, I am getting error 13 and mismatch error when I am trying to run code. I am wondering if any of you can kindly help? many thanks in advance.
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "C:\Inventory\"
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, 10))
Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub
I am trying to transfer several rows (there isnt specific number of rows) from column J from several worksheet saved in my C drive in a folder named "inventory" into my master sheet. I have little knowledge in vba. I have the following code. However, I am getting error 13 and mismatch error when I am trying to run code. I am wondering if any of you can kindly help? many thanks in advance.
Sub copyDataFromMultipleWorkbooksIntoMaster()
Dim FolderPath As String, Filepath As String, Filename As String
FolderPath = "C:\Inventory\"
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, 10))
Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub