Move selected files to selected folder based on excel list

sprs248

New Member
Joined
Aug 20, 2019
Messages
18
Hi,
I want to move left blue colored files to rightly mentioned red colored folder in all below cases.

File name





Folder name
C:\Users\LENOVO\Desktop\New folderC:\Users\LENOVO\Desktop\New folder\CSC21251
CSC212512016120120161231.emd CSC21251
CSC212512017010120170131.emdCSC21251
CSC212512017020120170228.emdCSC21251
CSC213032016120120161231.emdCSC21303
CSC213032017010120170131.emdCSC21303
CSC213032017020120170228.emdCSC21303
CSC217242016050120160531.emdCSC21724
CSC219082016090120160930.emdCSC21908
CSC219082016100120161031.emdCSC21908
CSC219082016110120161130.emdCSC21908

<colgroup><col><col></colgroup><tbody>
</tbody>

THANKS...
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Hi i am not expert in Coding but Try with the below code

Conditions:
Cell "A2" should contain Source Path and Cell "B2" should contain Destination Path and Column C should contain File Names
and by your question i understood that you need to copy only .emd files so only i have hard-coded that

Code:
Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim SourceFileName, SourceFileName1 As String, DestinFileName, DestinFileName1, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    SourceFileName1 = Range("A2").Value
    DestinFileName1 = Range("B2").Value
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
    For x = 2 To lr
        Filename = Range("C" & x).Value
        SourceFileName = SourceFileName1 & "\" & Filename & ".emd"
        DestinFileName = DestinFileName1 & "\" & Filename & ".emd"
        If Not FSO.FileExists(SourceFileName) Then
            MsgBox ("File Not Found in " & SourceFileName)
        Else
            FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
            MsgBox (SourceFileName + " Moved to " + DestinFileName)
        End If
    Next x
    
End Sub

Regards
Dhruva
 
Last edited:
Upvote 0
Hi i am not expert in Coding but Try with the below code

Conditions:
Cell "A2" should contain Source Path and Cell "B2" should contain Destination Path and Column C should contain File Names
and by your question i understood that you need to copy only .emd files so only i have hard-coded that

Code:
Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim SourceFileName, SourceFileName1 As String, DestinFileName, DestinFileName1, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    SourceFileName1 = Range("A2").Value
    DestinFileName1 = Range("B2").Value
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
    For x = 2 To lr
        Filename = Range("C" & x).Value
        SourceFileName = SourceFileName1 & "\" & Filename & ".emd"
        DestinFileName = DestinFileName1 & "\" & Filename & ".emd"
        If Not FSO.FileExists(SourceFileName) Then
            MsgBox ("File Not Found in " & SourceFileName)
        Else
            FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
            MsgBox (SourceFileName + " Moved to " + DestinFileName)
        End If
    Next x
    
End Sub

Regards
Dhruva
After Run, No response..
 
Upvote 0
Yes worked it... But I want to do this process in all rows data, mentioned at first Comment.




File name




Folder name
C:\Users\LENOVO\Desktop\New folderC:\Users\LENOVO\Desktop\New folder\CSC21251
CSC212512016120120161231.emdCSC21251
CSC212512017010120170131.emdCSC21251
CSC212512017020120170228.emdCSC21251
CSC213032016120120161231.emdCSC21303
CSC213032017010120170131.emdCSC21303
CSC213032017020120170228.emdCSC21303
CSC217242016050120160531.emdCSC21724
CSC219082016090120160930.emdCSC21908
CSC219082016100120161031.emdCSC21908
CSC219082016110120161130.emdCSC21908

<tbody>
</tbody>
I have large volume of files for moving...
 
Upvote 0
Hi @sprs248,

Try with the below code

Code:
Option Explicit


Sub MoveFiles()
    Dim FSO As Object
    Dim PATH, sourcefile As String, dest, DestinationFolderName, SourceFileName, Filename As String
    Dim lr, x As Long
    
    Set FSO = CreateObject("Scripting.Filesystemobject")
    PATH = Range("D2").Value
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    If PATH <> "" Then
        For x = 2 To lr
            SourceFileName = Range("A" & x).Value
            DestinationFolderName = Range("B" & x).Value
            sourcefile = PATH & "\" & SourceFileName & ".emd"
            dest = PATH & "\" & DestinationFolderName & "\" & SourceFileName & ".emd"
            If Not FSO.FileExists(sourcefile) Then
                MsgBox ("File Not Found in " & sourcefile)
            Else
                FSO.MoveFile source:=sourcefile, Destination:=dest
                MsgBox (sourcefile + " Moved to " + dest)
            End If
        Next x
    Else
        MsgBox ("Please Insert PATH in cell 'D2'")
        Exit Sub
    End If
End Sub

Regards
Dhruva
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,943
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top