Again, thank you for that..
so this is what i have now..
Sub Consolidate()
'Author: Jerry Beaucaire'
'Date: 9/15/2009 (2007 compatible)
'Summary: Open all Excel files in a specific folder and merge data
' into one master sheet (stacked)
' Moves imported files into another folder
Dim fName As String, fPath As String, fPathDone As String, OldDir As String
Dim LR As Long, NR As Long
Dim wbData As Workbook, wbkNew As Workbook
'Setup
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set wbkNew = ThisWorkbook
wbkNew.Activate
Sheets("Master").Activate 'sheet report is built into
If MsgBox("Import new data to this report?", vbYesNo) = vbNo Then Exit Sub
If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
Cells.Clear
NR = 1
Else
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
End If
'Path and filename (edit this section to suit)
fPath = "C:\Users\Desktop\Excel Testing\" 'remember final \ in this string
fPathDone = fPath & "Imported\" 'remember final \ in this string
On Error Resume Next
MkDir fPathDone 'creates the completed folder if missing
On Error GoTo 0
OldDir = CurDir 'memorizes the users current working path
ChDir fPath 'activate the filepath with files to import
fName = Dir("*.xls") 'listing of desired files, edit filter as desired
'Import a sheet from found file
Do While Len(fName) > 0
If fName <> wbkNew.Name Then 'make sure this file isn't accidentally reopened
'Open file
Set wbData = Workbooks.Open(fName)
'This is the section to customize, replace with your own action code as needed
'Find last row and copy data
LR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
If NR = 1 Then 'copy the titles and data
Sheets("Sheet1").Range("A1:A" & LR).EntireRow.Copy _
wbkNew.Sheets("Master").Range("A" & NR)
Else 'copy the data only
Sheets("Sheet1").Range("A2:A" & LR).EntireRow.Copy _
wbkNew.Sheets("Master").Range("A" & NR)
End If
'close file
wbData.Close False
'Next row
NR = Range("A" & Rows.Count).End(xlUp).Row + 1
'ready next filename
fName = Dir
End If
Loop
ErrorExit: 'Cleanup
ActiveSheet.Columns.AutoFit
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
ChDir OldDir 'restores users original working path
End Sub
When i run this, it locks up and crashes "not responding" ..?
Any ideas?
Bookmarks