A macro to move specific files from a folder

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

VBA editor in Excel

Sub MoveFiles()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim bone As Workbook
Set bone = ActiveWorkbook
bone.Activate

For Each ws In bone.Worksheets
ws.AutoFilterMode = False
Next ws

For Each she In bone.Worksheets
If she.Name = "File names" Then
Source = she.Name
Exit For
End If
Next

Sheets(Source).Activate

Dim iRow As Integer
Dim sSourcePath As String
Dim sDestinationPath As String
Dim icolumn As Long
Dim ilastcolumn As Long
Dim bContinue As Boolean

bContinue = True
icolumn = Sheets(Source).Rows("1:1").Find("For moving").Column
ilastcolumn = Sheets(Source).Cells(2, icolumn).End(xlToRight).Column
iRow = 5 'ROW STARTING FROM

'THE SOURCE AND DESTINATION FOLDER WITH PATH
sSourcePath = "C:\source folder path"
sDestinationPath = "C:\destination folder path"

If Right(sSourcePath, 1) <> "\" Then sSourcePath = sSourcePath & "\"
If Right(sDestinationPath, 1) <> "\" Then sDestinationPath = sDestinationPath & "\"

'LOOP THROUGH COLUMN TO PICK THE FILES
While bContinue 'WHILE BCONTINUE HOLDS TRUE

'DO NOTHING IF THE COLUMN IS BLANK
If Cells(iRow, icolumn).Value = "" Then

'DONE
MsgBox "Executed, please check"
bContinue = False

Else
'CHECK IF FILES EXISTS

If Dir(sSourcePath & Cells(iRow, icolumn).Value) = "" Then
Cells(iRow, ilastcolumn + 1).Value = "Does Not Exist"
Else
Cells(iRow, ilastcolumn + 1).Value = "On Hand"
If Trim(sDestinationPath) <> "" Then
Dim objFSO
Set objFSO = CreateObject("scripting.filesystemobject")

'CHECK IF DESTINATION FOLDER EXISTS
If objFSO.FolderExists(sDestinationPath) = False Then
MsgBox sDestinationPath & " Does Not Exists"
Exit Sub
End If


'*****
'HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
'I HAVE COMMENTED THE SECOND METHOD. TO USE SECOND METHOD, 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 ROW COUNTER.
iRow = iRow + 1
Wend

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

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

Leave a Reply

Your email address will not be published. Required fields are marked *