I used this “move specific files” macro trick under these scenarios:
- file sorting in a folder
- find and separate files from others in a folder
VBA macro code
💡Step 1:Prepare a list of the file names that you need to move, here is a macro to serve this purpose.
💡Step 2: Press Alt + F11 to open VBA editor in Excel
Sub MoveFiles()
Application.Calculation = xlCalculationManual Dim bone As Workbook For Each ws In bone.Worksheets For Each she In bone.Worksheets Sheets(Source).Activate Dim iRow As Integer bContinue = True 'THE SOURCE AND DESTINATION FOLDER WITH PATH If Right(sSourcePath, 1) <> "\" Then sSourcePath = sSourcePath & "\" 'LOOP THROUGH COLUMN TO PICK THE FILES 'DO NOTHING IF THE COLUMN IS BLANK 'DONE Else If Dir(sSourcePath & Cells(iRow, icolumn).Value) = "" Then 'CHECK IF DESTINATION FOLDER EXISTS
'INCREMENT ROW COUNTER. Application.Calculation = xlCalculationAutomatic |
Explanation
MoveFiles is this macro name, change it as you like, just keep in mind that no space in between the words of the name
Sub MoveFiles()
Pre-setting in order to run the macro faster: make the calculation function in manual way and turn off the screen update and display alerts
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
bone is the name of the workbook in which you trigger this macro, change the name as you like”
Dim bone As Workbook
Set bone = ActiveWorkbook
bone.Activate
Turn off all the auto filters of each worksheet
For Each ws In bone.Worksheets
ws.AutoFilterMode = False
Next ws
I pre-named one worksheet in this workbook to be ‘File names’ which contains the list file names that need to move from a folder to another
Locate the worksheet ‘File names’ in this workbook and ask macro to memorize it by calling it as ‘Source’
For Each she In bone.Worksheets
If she.Name = "File names" Then
Source = she.Name
Exit For
End If
Next
Sheets(Source).Activate
Dim as Dimension, to declare variable names and their types, change the names as you like, just keep in mind to keep the same names throughout the macro
Dim iRow As Integer
Dim sSourcePath As String
Dim sDestinationPath As String
Dim icolumn As Long
Dim ilastcolumn As Long
Dim bContinue As Boolean
Preset bContinue as with true value
bContinue = True
Define which columns and rows in the worksheets should be checked by macro
icolumn = Sheets(Source).Rows("1:1").Find("For moving").Column
ilastcolumn = Sheets(Source).Cells(2, icolumn).End(xlToRight).Column
iRow = 5 Starts from row 5, change to suit your needs
List your source and destination folders with path
sSourcePath = "C:\source folder path"
sDestinationPath = "C:\destination folder path"
In case your path is without "\" after copy paste
If Right(sSourcePath, 1) <> "\" Then sSourcePath = sSourcePath & "\"
If Right(sDestinationPath, 1) <> "\" Then sDestinationPath = sDestinationPath & "\"
Start to loop through the defined columns to pick the file in the folder
While bContinue At the start, bContinue holds true value
If the cell is blank, then stop the execution, pop up a message mentioning the marco is finished and turn bContinue to be with false value
If Cells(iRow, icolumn).Value = "" Then
MsgBox "Executed, please check"
bContinue = False
If the cell is not blank, then continue processing
Else
First, check if the file exists in the source folder. If it doesn’t exist, note down ‘does not exist’ in the cell next to the file name in the worksheet.
If Dir(sSourcePath & Cells(iRow, icolumn).Value) = "" Then
Cells(iRow, ilastcolumn + 1).Value = "Does Not Exist"
Else
If it exists, note down ‘on hand’ and check if the destination folder path exists
Cells(iRow, ilastcolumn + 1).Value = "On Hand"
If Trim(sDestinationPath) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")
if the destination folder path doesn’t not exist, pop out a message to advise the user to check the correct folder path
If objFSO.FolderExists(sDestinationPath) = False Then
MsgBox sDestinationPath & " Does Not Exists"
Exit Sub
End If
*****
Here are two different ways to move the files, one is just to copy the files to the destination folder while another one is to permanently move the files to there.
In this case, I used the method 1 to copy the files to the destination folder
To use the second method instead, just remove ' before objFSO of the method 2 and add ' before objFSO of the method 1
METHOD 1) USING "CopyFile" METHOD TO COPY THE FILES
objFSO.CopyFile Source:=sSourcePath & Cells(iRow, icolumn).Value, Destination:=sDestinationPath
METHOD 2) USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES
'objFSO.MoveFile Source:=sSourcePath & Cells(iRow, icolumn).Value, Destination:=sDestinationPath
'*****
End If
End If
End If
Increment the row number by 1 after each file was moved
iRow = iRow + 1
Wend
Turn the calculation back to be automatic and turn back on the screen update and display alerts
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub