Note: The other languages of the website are Google-translated. Back to English

How to copy or move files from one folder to another based on a list in Excel? 

If you have a list of file names in a column in a worksheet, and the files locate in a folder in your computor. But, now, you need to move or copy these files which names are listed into the worksheet from their original folder to another one as following screenshot shown. How could you finish this task as quickly as you can in Excel?

Copy or move files from one folder to another based on a list in Excel with VBA code


Copy or move files from one folder to another based on a list in Excel with VBA code

To move the files from one folder to another based on a list of files names, the following VBA code may do you a favor, please do as this:

1. Hold down the Alt + F11 keys in Excel, and it opens the Microsoft Visual Basic for Applications window.

2. Click Insert > Module, and paste the following VBA code in the Module Window.

VBA code: Move files from one folder to another based on a list in Excel

Sub movefiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = " Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = " Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
            Kill xSPathStr & xVal
        End If
    Next
End Sub

3. And then press F5 key to run this code, and a prompt box will pop out to remind you selecting the cells which contain the file names, see screenshot:

4. Then click OK button, and in the popped out window, please select the folder which contains the files that you want to move from, see screenshot:

5. And then click OK, go on selecting the destination folder where you want to locate the files in another popped out window, see screenshot:

6. Finally, click OK to close the window, and now, the files have been moved into another folder you specified based on the file names in worksheet list, see screenshot:

Note: If you just want to copy the files to another folder, but keep the original files, please apply the below VBA code:

VBA code: Copy files from one folder to another based on a list in Excel

Sub copyfiles()
'Updateby Extendoffice
    Dim xRg As Range, xCell As Range
    Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
    Dim xSPathStr As Variant, xDPathStr As Variant
    Dim xVal As String
    On Error Resume Next
    Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xSFileDlg.Title = "Please select the original folder:"
    If xSFileDlg.Show <> -1 Then Exit Sub
    xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
    Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
    xDFileDlg.Title = "Please select the destination folder:"
    If xDFileDlg.Show <> -1 Then Exit Sub
    xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
    For Each xCell In xRg
        xVal = xCell.Value
        If TypeName(xVal) = "String" And xVal <> "" Then
            FileCopy xSPathStr & xVal, xDPathStr & xVal
        End If
    Next
End Sub

 


The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
officetab bottom

 

Comments (60)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
It is the nice macro.Real helpful for me. but I need some update macro.this used to copy the files from single folder to another folder. we need copy files from folder and subfolder to another folder.
This comment was minimized by the moderator on the site
Hi, In the source folder, I wish to set it as a constant from a cell, for example the path entered in a particular cell, like A1, should be treated as the source folder. How to do this?
This comment was minimized by the moderator on the site
Era exatamente isso que eu precisava!!!

Muito Obrigado!!!!
This comment was minimized by the moderator on the site
Obrigado!!!!
This comment was minimized by the moderator on the site
Você não tem noção de como me ajudou com esse script... Muito bom!!! Obrigado!!!
This comment was minimized by the moderator on the site
Hi Guys,

How I need to change '' If TypeName(xVal) = "String" And xVal <> "" Then '' to move files based on partial file name.


Thanks in advance,
Best regards, P
This comment was minimized by the moderator on the site
Did you ever find out HOW to use a PARTIAL FILE NAME? I need that as well...
In other words, if file name on the Excel sheet list is: OW4234TR_J19031.txt (I'd like it to only look at last 5 chars "19031" which is a Julian Date and move a range of files... anything with a Julian Date of 19031 thru 19075..
This comment was minimized by the moderator on the site
I also would require the partial file name vba modification. Did you ever get a response?
This comment was minimized by the moderator on the site
I am interested in exactly the same solution! Did anyone get the answer?I have a P/N list in a column, and I want a piece of code that looks in a parent folder that has several subfolders after files with the name indicated by the list, but only partially, because I don't know the file extension and in many cases for a single P/N in the list, I have several files differentiated by the existence of a suffix that does not always have the same pattern, such as xxxx_1, xxxx_2, xxx (1), xxxx [1], xxxx- (a ), xxxx_ (b) ...., but I need to copy in the destination folder, all the instances of the files that contain in their name the P/N.Please help me to not do this job manually for 34078 files that today finds in parent folder and subfolders
This comment was minimized by the moderator on the site
Hello,
how to make this code copy files from subfolders?
This comment was minimized by the moderator on the site
Any tips on how to modify the code to add a wide card? I have an archive of hundreds of PDF files that are 10 digit numbers and revision level (XXXXXXXXXX_REVA). I can export a list of file names very easily from our ERP system, but the list is missing the revision and file extension. Is there a way to add wild cards into the program to ignore everything BUT the 10 digit number?
This comment was minimized by the moderator on the site
I cannot get either version to work in Windows 10.


Argggg
This comment was minimized by the moderator on the site
en el codigo que copia ¿como puedo colorear el nombre de la lista que no encuentre?
This comment was minimized by the moderator on the site
Works great - thank you! However-->>>Can this be adjusted to use a PARTIAL FILE NAME? If so, can you help show how?
In other words, if file name on the Excel sheet list of filenames is: OW4234TR_J19031.txt (I'd like it to only look at last 5 chars "19031" which is a Julian Date and move a range of files... (anything with a Julian Date of 19092 thru 19120) into the March folder.. The ultimate over-arching task is to locate any files that have Julian dates for March and put those in the Fiscal March Folder "06-Mar" , April into the April folder "07-Apr" and so on...so Fiscal reconciliations by month can then take place.. TIA for any help anyone can offer to expedite this time consuming hunt and picking process. =-)
This comment was minimized by the moderator on the site
hi do you know how to search also on the subfolder ?
This comment was minimized by the moderator on the site
Has anyone figured out how to copy files that are located in multiple subfolders of the main directory, and paste into another folder directory? Also does this transfer method only work for folders on the C drive? I am trying to copy files from our directory that includes multiple subfolders where several files are stored located in Microsoft Sharepoint, to a folder on my C drive.

Any help would be much appreciated!
This comment was minimized by the moderator on the site
thanks so much !
This comment was minimized by the moderator on the site
buenas noches, alguien sabe que tengo que modificar para que me mueva carpetas y no solo archivos?
This comment was minimized by the moderator on the site
Any update of how to search on folder and subfolders
This comment was minimized by the moderator on the site
Hi, Nasr,
To move files from folder and subfolders based on cell values, please apply the below VBA code:
Please try, hope it can help you!

Sub movefiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim fso As Object, folder1 As Object
' On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = " Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Call sMoveFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sub sMoveFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
Dim xCell As Range
Dim xVal As String
Dim xFolder As Object
Dim fso As Object
Dim xF As Object
Dim xStr As String
Dim xFS As Object
Dim xI As Integer
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Then
MkDir (xDPathStr)
End If
For xI = 1 To xRg.Count
Set xCell = xRg.Item(xI)
xVal = xCell.Value
If TypeName(xVal) = "String" And Not (xVal = "") Then
On Error GoTo E1
If Dir(xSPathStr & xVal, 16) <> Empty Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
Kill xSPathStr & xVal
End If
End If
E1:
Next xI
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set xFS = fso.GetFolder(xSPathStr)
For Each xF In xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Call sMoveFiles(xRg, xF.ShortPath & "\", xStr & "\")
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
And (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then
RmDir xStr
End If
Next
End Sub
This comment was minimized by the moderator on the site
That's perfect thank you
but what about if I just wanted to copy files not moving it from subfolders only without the need of creating subfolders in the destination folder
ie
source folder X:\\parent
inside parent is subfolders test1(file A), test2(file B) and test3(file C)
then destination folder is "Y:\\destination" has all 3 files A, B, C without the subfolders

Thank you very much
This comment was minimized by the moderator on the site
Hi Nasr, did you figure out how to do this? I am looking at a similar need at the moment.

Copying a selection of files from various subfolders to a single folder
This comment was minimized by the moderator on the site
Hi Mike
I kind of did BUT indirectly, so what I did is modify the code to copy the files not move them with the subfolder
then with CMD file move the file from subfolders to the main folder then delete the empty subfolder
this is what I did

Sub Copyfiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
Dim fso As Object, folder1 As Object
' On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = " Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = " Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"
Call sCopyFiles(xRg, xSPathStr, xDPathStr)
End Sub

Sub sCopyFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
Dim xCell As Range
Dim xVal As String
Dim xFolder As Object
Dim fso As Object
Dim xF As Object
Dim xStr As String
Dim xFS As Object
Dim xI As Integer
On Error Resume Next
If Dir(xDPathStr, vbDirectory) = "" Then
MkDir (xDPathStr)
End If
For xI = 1 To xRg.Count
Set xCell = xRg.Item(xI)
xVal = xCell.Value
If TypeName(xVal) = "String" And Not (xVal = "") Then
On Error GoTo E1
If Dir(xSPathStr & xVal, 16) <> Empty Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
End If
E1:
Next xI
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set xFS = fso.GetFolder(xSPathStr)
For Each xF In xFS.SubFolders
xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Call sCopyFiles(xRg, xF.ShortPath & "\", xStr & "\")
If (CreateObject("scripting.FileSystemObject").GetFolder(xStr).Files.Count = 0) _
And (CreateObject("scripting.FileSystemObject").GetFolder(xStr).SubFolders.Count = 0) Then
RmDir xStr
End If
Next
End Sub



then copy the following lines to a new notepad then save it as cmd call it whatever

for /r %%a IN (*.*) do (
move /y "%%a" "%cd%"
)
for /f "delims=" %%d in ('dir /s /b /ad ^| sort /r') do rd "%%d"



make sure to copy the code as is 4 lines
hope that help
This comment was minimized by the moderator on the site
make sure to put the cmd file in the same folder that you copy the files and subfolders to then double click it
This comment was minimized by the moderator on the site
You can achieve the same result using only the VBA if you add a ' before the & "\" & xF.Name in the below line.
This still copies from subfolders but copies to a single level folder.

xStr = xDPathStr & "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
Becomes
xStr = xDPathStr '& "\" & xF.Name ' Replace(xF.ShortPath, xSPathStr, xDPathStr)
This comment was minimized by the moderator on the site
Hi skyyang,I want to copy or move files (.jpg, .png) any format from folder & its sub-folders. The above script is copying the whole folder containing the matched file
Thanks & Regards,
This comment was minimized by the moderator on the site
HI, I am not an expert in VBA but need your Module and I did as you instruct but nothing copied from source folder to the new folder. and no error is shown
This comment was minimized by the moderator on the site
An what happen if the file doesn't existe in the origin folder?
the code breaks

The code shall has a line to jump to another reference if doesn't exist
This comment was minimized by the moderator on the site
If the reference doesn't exist the code break
wich line shall I had to the code do a jump through the next reference without stop
This comment was minimized by the moderator on the site
How could this be adapted to paste into a list of multiple file paths instead of one path at a time?
This comment was minimized by the moderator on the site
Hello, sabin,
Do you want to copy and paste the files which from multiple original folders instead of only one folder?
This comment was minimized by the moderator on the site
yes please
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations