L
laavista
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
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