Try something like this:
Code:
Sub EditFileDirectory()
Dim path As String
Dim ThisWB As String
Dim Filename As String
Dim Wkb As Workbook
Dim lastR As Long
'Toggle off for speed
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo ErrorTrap
ThisWB = ActiveWorkbook.Name
path = "C:\Users\mmickle\Desktop\MyTest" 'Your File Directory Here
Filename = Dir(path & "\*.xlsx", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Sheets(2).UsedRange.Copy 'Copy Data....<---- You may need to use ActiveWorkBook.Name to get your sheet name
Windows(ThisWB).Activate 'Activate Master WorkBook
lastR = Sheets("MasterCompilation").Range("A" & Rows.Count).End(xlUp).Row 'Define last row <---Change Sheet Name Accordingly
Range("A" & lastR + 1).PasteSpecial 'Paste on first open last row
Windows(Filename).Activate 'Re-activate File to clear data
Sheets(2).UsedRange.ClearContents 'clear data
Wkb.Close True 'close file and save changes
End If
Filename = Dir() 'Go to next file in directory
Loop
'Toggle back on
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "File editing is now complete", vbInformation, "ExcelFox- File Editor"
On Error GoTo 0 'Reset Error Handling
Exit Sub
ErrorTrap:
MsgBox "Error Num: " & Err.Number _
& Chr(13) & "Error Desc: " & Err.Description _
& Chr(13) & Chr(13) & "An unexpected error occured. Please contact" _
& Chr(13) & "File Administrator to help diagnose the issue." _
, vbCritical, "ExcelFox- Error Handler"
End Sub
Bookmarks