Sub Open_Latest_File_Copy_Move()
Dim strPath As String
Dim strDest As String
Dim myFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim Lmd As Date
Dim Wb As Workbook
Dim fso As Object
'The Folder 'Test' Contains The File To Be Checked
strPath = ThisWorkbook.Path & "\Test\"
'The Folder 'Final' Where The File Will Be Moved
strDest = ThisWorkbook.Path & "\Final\"
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
myFile = Dir(strPath & "*.xls*", vbNormal)
If Len(myFile) = 0 Then
MsgBox "No Files Were Found...", vbExclamation
Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While Len(myFile) > 0
Lmd = FileDateTime(strPath & myFile)
If Lmd > LatestDate Then
LatestFile = myFile
LatestDate = Lmd
End If
myFile = Dir
Loop
Set Wb = Workbooks.Open(strPath & LatestFile)
Wb.Sheets("Sheet1").UsedRange.Copy ThisWorkbook.Sheets("Sheet1").Range("A1")
Wb.Close SaveChanges:=False
strPath = strPath & LatestFile
Call fso.CopyFile(strPath, strDest)
Kill strPath
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set Wb = Nothing
MsgBox "Done...", 64
End Sub