Here is the final code I put in ThisWorkbook of "Test.xlsm"
If it wasn't for the help of everyone here, I would not have gotten this far with it. Thank you.
------------------------------------------------------------------------------------
Private Sub Workbook_Open()
Dim sThisFilePath As String
Dim sFile, sFileName, shToday, shTomorrow As String
Dim wbBook As Workbook
Dim wkSheet, FirstSht, SecondSht As Worksheet
Dim mFinalRow, sFinalRow, newFinalRow As Long
Dim Today, Tomorrow As Date
Dim d, j
Application.ScreenUpdating = False
Today = Date
If Weekday(Today) = 6 Then
Tomorrow = Date + 3
Else
Tomorrow = Date + 1
End If
shToday = Format(Today, "ddmmmyyyy")
shTomorrow = Format(Tomorrow, "ddmmmyyyy")
For Each wkSheet In ThisWorkbook.Worksheets
If wkSheet.Name = shToday Then GoTo EndOfCode
Next wkSheet
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Sheets(1)
ActiveSheet.Select
'Sheets("Sheet1").Visible = False
ActiveSheet.Name = shToday
Set nSheet = ActiveSheet
sThisFilePath = ActiveWorkbook.Path
If (Right(sThisFilePath, 1) <> "\") Then sThisFilePath = sThisFilePath & "\"
sFile = Dir(sThisFilePath & "*.xls*")
'MsgBox "The path is " & sThisFilePath
ChDir (sThisFilePath)
Do While sFile <> vbNullString
'MsgBox "The next file is " & sFile
'if the next file is same as "active file" then skip the file
If (sFile = "Test.xlsm") Then GoTo Next_File
'Opens the next workbook in that folder
Set wbBook = Workbooks.Open(sThisFilePath & sFile)
'Creates a copy of the Resource update sheet in the resource file
wbBook.Sheets("Sheet2").Visible = True
Set OldSheet = Workbooks(sFile).Worksheets(shToday)
wbBook.Sheets("Sheet2").Copy After:=wbBook.Sheets(2)
'Names the new sheet with the date
wbBook.ActiveSheet.Name = shTomorrow
Set NwSheet = wbBook.ActiveSheet
wbBook.Sheets("Sheet2").Visible = False
'Updates the resource workbook for the next day
d = 1
j = 2
Do Until IsEmpty(OldSheet.Range("A" & j))
If (OldSheet.Range("K" & j) = "No") Then
d = d + 1
NwSheet.Rows(d).Value = OldSheet.Rows(j).Value
ElseIf (OldSheet.Range("K" & j) = "no") Then
d = d + 1
NwSheet.Rows(d).Value = OldSheet.Rows(j).Value
ElseIf OldSheet.Range("K" & j) = "" Then
d = d + 1
NwSheet.Rows(d).Value = OldSheet.Rows(j).Value
End If
j = j + 1
Loop
'Find the final row of the newly opened workbook
sFinalRow = Workbooks(sFile).Worksheets(shToday).Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox "The final row is " & sFinalRow
If sFinalRow = 1 Then GoTo Close_File:
'Copy from A2:I(sFinalRow) from current workbook
Workbooks(sFile).Worksheets(shToday).Range("A2:K" & sFinalRow).Copy
'Find the last row in the main workbook then adds 1
mFinalRow = nSheet.Cells(Rows.Count, 1).End(xlUp).Row
mFinalRow = mFinalRow + 1
'Paste those copied cells in the first available open row
nSheet.Cells(mFinalRow, 1).PasteSpecial xlValues
sFileName = Left(sFile, (InStrRev(sFile, ".", -1, vbTextCompare) - 1))
nSheet.Range("L" & mFinalRow, "L" & mFinalRow + sFinalRow - 2).Value = sFileName
Application.CutCopyMode = False
Close_File:
wbBook.Close SaveChanges:=True
Next_File:
sFile = Dir
Loop
Set wbBook = Nothing
EndOfCode:
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------------------------------------
Here is what I put in the user workbooks to prevent an Open workbook causing my main workbook to fail. I pulled this code from another site.
In ThisWorkbook
-----------------------------------------------------------------------------------------------
Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
----------------------------------------------------------------------------------------------
In a module
----------------------------------------------------------------------------------------------
Public CloseDownTime As Variant
Public Sub ResetTimer()
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then Application.OnTime EarliestTime:=CloseDownTime, Procedure:="CloseDownFile", Schedule:=False
CloseDownTime = Now + TimeValue("00:30:00") ' hh:mm:ss
Application.OnTime CloseDownTime, "CloseDownFile"
End Sub
Public Sub CloseDownFile()
On Error Resume Next
Application.StatusBar = "Inactive File Closed: " & ThisWorkbook.Name
ThisWorkbook.Close SaveChanges:=True
End Sub
----------------------------------------------------------------------------------------------
