Greetings,
I have a macro that scours files in a directory for worksheets containing the word Data as the first 4 characters of the worksheet name, copies the data in those worksheets to a "Master" file. It worked fine as of last week, but now is hanging when closing the first of the workbooks it opens. The code is as follows:
Sub AutoCompile()
'
' AutoCompile Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Dim objWB As Workbook, SourcePath As String, wbName As String
Dim LastRow As Long, LastCol As Long, NextRow As Long, DestSheet As Worksheet, i%
NextRow = 1
SourcePath = "T:\DEBT DATABASE\MASTER FILES\New Master Files\"
Set DestSheet = ThisWorkbook.Worksheets("Debtors")
'Checks to see if directory is a valid directory
On Error Resume Next
ChDrive "T"
ChDir SourcePath
If Err.Number <> 0 Then
Err.Clear
MsgBox "There is no folder path on your computer named" & vbCrLf & SourcePath & ".", 48, "Cannot continue, no such animal."
Exit Sub
End If
wbName = Dir("*.xlsx")
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.AskToUpdateLinks = False
Dim sh As Worksheet
Dim myPassword As String
myPassword = "iou"
'Prepares Appended Master File for Processing
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect Password:=myPassword
Next sh
Sheets("Debtors").Select
Cells.Select
Selection.Delete Shift:=xlUp
'Verifies there are files in the directory to process
Do
On Error Resume Next
Set objWB = Workbooks.Open(SourcePath & wbName)
If Err.Number <> 0 Then
Err.Clear
With Application
.AskToUpdateLinks = True
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With
MsgBox "There were no files with the specified extension" & vbCrLf & "in the path " & SourcePath & ".", 48, "Cannot continue, nothing to open."
Exit Sub
End If
'Copies data from Data tabs on all sheets to Appended Master File
For i = 1 To Sheets.Count
If Left(Sheets(i).Name, 4) = "Data" Then
Sheets(i).Activate
LastRow = Range("B65536").End(xlUp).Row
Range(Cells(2, 1), Cells(LastRow, 120)).Copy
DestSheet.Activate
Range("B" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
RowTotal = Range("C65536").End(xlUp).Row
NextRow = RowTotal + 1
objWB.Activate
End If
Next i
objWB.Close False
wbName = Dir
Loop While wbName <> ""
Any advice as to what has happened would be greatly appreciated.
Thanks!
Bookmarks