Option Explicit
Sub MoveFiles()
'This code should be located in a standard module in the Master List workbook
'Be sure to modify the 4 constants listed after the comments that delimited with //
Dim strFolderA As String
Dim strFolderB As String
Dim strFile As String
Dim strMasterListWorksheetName As String
Dim iSaveFileNameColumn As Integer
Dim Cnt As Long
Dim oFound As Object
'//Source folder path//
strFolderA = "D:\Nov 11\"
'//Destination folder path//
strFolderB = "D:\Master List Files\"
'//Worksheet in this work book that contains the list of files to move//
strMasterListWorksheetName = "Sheet1"
'//Column number in strMasterListWorksheetName that contains the files to move//
iSaveFileNameColumn = 1 'A-1, B=2, C=3, etc.
If Right(strFolderA, 1) <> "\" Then strFolderA = strFolderA & "\"
If Right(strFolderB, 1) <> "\" Then strFolderB = strFolderB & "\"
If Dir(strFolderA, 16) <> "." Then
MsgBox "Directory " & strFolderA & " does not exist. Correct reference in this code and try again."
GoTo End_Sub
End If
If Dir(strFolderB, 16) <> "." Then
MsgBox "Directory " & strFolderB & " does not exist. Correct reference in this code and try again."
GoTo End_Sub
End If
'To filter for .xlsx files, change "*.*" to "*.xlsx"
strFile = Dir(strFolderA & "*.*")
'Clear background colors in master list
ThisWorkbook.Worksheets(strMasterListWorksheetName).Columns("A:A").Interior.ColorIndex = -4142
Do While Len(strFile) > 0
Set oFound = ThisWorkbook.Worksheets(strMasterListWorksheetName).Columns("A:A") _
.Find(What:=strFile, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not oFound Is Nothing Then
'File was on list
oFound.Interior.ColorIndex = 27 'Color the cell on the master list yellow
Cnt = Cnt + 1
Name strFolderA & strFile As strFolderB & strFile 'move the file
End If
strFile = Dir
Loop
MsgBox Cnt & " file(s) have been transfered to " & strFolderB, vbInformation
End_Sub:
End Sub
