Merge data from two temp files into a master
I need to merge the data in multiple workbooks (called TempFiles) into a
Master workbook. If I merge the data in just one workbook into the Master file, it worked fine. But I need to loop through each TempFile and merge it in. I'm getting "out of range" error on the line " ThisWorkbook.Sheets("OpenOrders").Range("A" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("A" & RowCount).Value" Can anyone help? THANKS ====== Option Explicit Public Sub MergeTempFiles() On Error GoTo Error_Handler Dim cell As Range Dim cel As Range Dim Path As String 'string variable to hold the path to look through Dim FileName As String 'temporary filename string variable Dim TempFile As Workbook Dim irow As Long Dim OpenOrdersLastRow As Long Dim TempFileLastRow As Long Dim tempfilerow As Integer Dim RowCount As Integer Worksheets("OpenOrders").Activate 'makes worksheet active ' find last row in "OpenOrders" ========================================= OpenOrdersLastRow = 0 irow = Cells(65536, "B").End(xlUp).Row If irow OpenOrdersLastRow Then OpenOrdersLastRow = irow ' ================================================== ===================== '***** Set folder to cycle through ***** Path = ThisWorkbook.Path & "\Temp_Open_files\" Application.EnableEvents = False 'turn off events Application.ScreenUpdating = False 'turn off screen updating FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable OpenOrdersLastRow = OpenOrdersLastRow + 1 tempfilerow = 2 ' ################################################## # Do Until FileName = "" 'loop until all files have been parsed Set TempFile = Workbooks.Open(FileName:=Path & FileName) ' find last row in "TempFile" ========================================= TempFileLastRow = ActiveSheet.Range("A65536").End(xlUp).Row ' ================================================== ============= RowCount = 2 Do Until RowCount = TempFileLastRow ' loop through all the rows in the TempFile ThisWorkbook.Sheets("OpenOrders").Range("A" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("A" & RowCount).Value ThisWorkbook.Sheets("OpenOrders").Range("B" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("B" & RowCount).Value ThisWorkbook.Sheets("OpenOrders").Range("C" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("C" & RowCount).Value RowCount = RowCount + 1 Loop TempFile.Close False 'close tempFile workbook without saving FileName = Dir() 'set next file's name to FileName variable OpenOrdersLastRow = OpenOrdersLastRow + 1 Loop ThisWorkbook.Save 'save MasterFile Application.EnableEvents = True 're-enable events Application.ScreenUpdating = True 'turn screen updating back on 'Clear memory of the object variables Set TempFile = Nothing Exit Sub Error_Handler: MsgBox "Error occurred in procedure MergeTempFiles" & vbCrLf & "Error Desc: " & Err.Description & vbCrLf & "Error Number:" & Err.Number, vbCritical, "Error!" Exit Sub End Sub |
Merge data from two temp files into a master
FOUND ANSWER. PLEASE IGNORE. THANKS
"laavista" wrote: I need to merge the data in multiple workbooks (called TempFiles) into a Master workbook. If I merge the data in just one workbook into the Master file, it worked fine. But I need to loop through each TempFile and merge it in. I'm getting "out of range" error on the line " ThisWorkbook.Sheets("OpenOrders").Range("A" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("A" & RowCount).Value" Can anyone help? THANKS ====== Option Explicit Public Sub MergeTempFiles() On Error GoTo Error_Handler Dim cell As Range Dim cel As Range Dim Path As String 'string variable to hold the path to look through Dim FileName As String 'temporary filename string variable Dim TempFile As Workbook Dim irow As Long Dim OpenOrdersLastRow As Long Dim TempFileLastRow As Long Dim tempfilerow As Integer Dim RowCount As Integer Worksheets("OpenOrders").Activate 'makes worksheet active ' find last row in "OpenOrders" ========================================= OpenOrdersLastRow = 0 irow = Cells(65536, "B").End(xlUp).Row If irow OpenOrdersLastRow Then OpenOrdersLastRow = irow ' ================================================== ===================== '***** Set folder to cycle through ***** Path = ThisWorkbook.Path & "\Temp_Open_files\" Application.EnableEvents = False 'turn off events Application.ScreenUpdating = False 'turn off screen updating FileName = Dir(Path & "*.xls", vbNormal) 'set first file's name to filename variable OpenOrdersLastRow = OpenOrdersLastRow + 1 tempfilerow = 2 ' ################################################## # Do Until FileName = "" 'loop until all files have been parsed Set TempFile = Workbooks.Open(FileName:=Path & FileName) ' find last row in "TempFile" ========================================= TempFileLastRow = ActiveSheet.Range("A65536").End(xlUp).Row ' ================================================== ============= RowCount = 2 Do Until RowCount = TempFileLastRow ' loop through all the rows in the TempFile ThisWorkbook.Sheets("OpenOrders").Range("A" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("A" & RowCount).Value ThisWorkbook.Sheets("OpenOrders").Range("B" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("B" & RowCount).Value ThisWorkbook.Sheets("OpenOrders").Range("C" & OpenOrdersLastRow).Value = ActiveWorkbook.Sheets("Sheet1").Range("C" & RowCount).Value RowCount = RowCount + 1 Loop TempFile.Close False 'close tempFile workbook without saving FileName = Dir() 'set next file's name to FileName variable OpenOrdersLastRow = OpenOrdersLastRow + 1 Loop ThisWorkbook.Save 'save MasterFile Application.EnableEvents = True 're-enable events Application.ScreenUpdating = True 'turn screen updating back on 'Clear memory of the object variables Set TempFile = Nothing Exit Sub Error_Handler: MsgBox "Error occurred in procedure MergeTempFiles" & vbCrLf & "Error Desc: " & Err.Description & vbCrLf & "Error Number:" & Err.Number, vbCritical, "Error!" Exit Sub End Sub |
All times are GMT +1. The time now is 03:24 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com