The macro is supposed to open and copy the data from onr workbook to another.
The issue im having is its not closing what I think is the last workbook and says backup file not updated and also get runtime error 13. Any ideas?
The issue im having is its not closing what I think is the last workbook and says backup file not updated and also get runtime error 13. Any ideas?
VBA Code:
Sub mergefiles()
Dim Notdone As String
Dim allSheets As String
Dim file As Object
Dim sht As Worksheet
Dim fso As Object
Set fso = CreateObject("new:{0D43FE01-F093-11CF-8940-00A0C9054228}") ' new fileSystemObject
Dim tgtWb As Workbook, srcWb As Workbook
Set tgtWb = ThisWorkbook
Dim ix As Long
For ix = 1 To tgtWb.Sheets.Count
allSheets = allSheets & "<" & tgtWb.Sheets(ix).Name & ">"
Next ix
For Each file In fso.GetFolder("c:\deletenow\").Files
If Not LCase(file) Like "*ergeall*" And Left(file, 1) <> "~" Then
On Error Resume Next
Call waitForAnyUnlock(file)
If Err <> 0 Then
Notdone = Notdone & vbLf & file.Name
Else
On Error GoTo 0
Set srcWb = Workbooks.Open(file)
For Each sht In srcWb.Sheets
If InStr(1, allSheets, "<" & sht.Name & ">", 1) > 0 Then
sht.UsedRange.Copy
With tgtWb.Sheets(sht.Name)
.Cells(.UsedRange.Rows.Count + .UsedRange.Row, 2).PasteSpecial xlPasteValues
End With
tgtWb.Sheets(sht.Name).Activate
Selection.Columns(1).Offset(0, -1) = srcWb.Name
End If
Next
srcWb.Close False
End If
End If
Next
Sheets("Instructions").Activate
MsgBox "Merge complete " & IIf(Notdone = "", ".", _
" except the following files were skipped because they were open" & Notdone)
End Sub