[VB help needed] Copy mulit folder files to Destination based on excel

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
column Acolumn Bcolumn C
Row 1File NameSource PathDestination Path (Copy)
Row 270401.PDFC:\Users\xxx\Desktop\MasterPath\Route 13C:\Users\xxx\Desktop\Saved Folder\70401
Row 370401.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70401
Row 470401.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70401
Row 570409.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70409
Row 670409.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70409

<tbody>
</tbody>

















Hi, i need some help as i had thousand of file to be move.
Is it possible to create marco and based on the excel list to COPY AND PASTE mulit folder files to Destination ?

For e.g i had 70401.PDF from Path C:\Users\xxx\Desktop\MasterPath\Route 13
COPY to C:\Users\xxx\Desktop\Saved Folder\70401
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
omg sorry that is error in the file name. should be like this


column Acolumn bcolumn c
Row 1File NameSource PathDestination Path (Copy)
Row 224.PDFC:\Users\xxx\Desktop\MasterPath\Route 13C:\Users\xxx\Desktop\Saved Folder\70401
Row 33.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70401
Row 4211.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70401
Row 5109.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70409
Row 6103.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70409

<tbody>
</tbody>
 
Upvote 0
How about
Code:
Sub CopyFile()

    Dim Cl As Range
    
    For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
        FileCopy Cl.Value & "\" & Cl.Offset(, -1).Value, _
            Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value
    Next Cl
    
End Sub
 
Upvote 0
thanks. but it dont work.

I found one very similar to the one i want but it has error. it dont auto create folder tht is not existing

http://www.vbaexpress.com/kb/getarticle.php?kb_id=828

How about
Code:
Sub CopyFile()

    Dim Cl As Range
    
    For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
        FileCopy Cl.Value & "\" & Cl.Offset(, -1).Value, _
            Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value
    Next Cl
    
End Sub
 
Upvote 0
I cant edit my post.. so i type it here

1. The destination directory (will be created if it does not already exist)
2. Cannot overwrite file.
 
Upvote 0
In that case try
Code:
Sub CopyFile()

    Dim Cl As Range
    Dim Fle As String
    
    
    For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
        Fle = ""
        If Dir(Cl.Offset(, 1).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 1).Value
        On Error Resume Next
        Fle = Dir(Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value)
        On Error GoTo 0
        If Fle = "" Then
            FileCopy Cl.Value & "\" & Cl.Offset(, -1).Value, _
                Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value
        End If
    Next Cl
    
End Sub
 
Upvote 0
Thanks! it works!

But can i have one more request?
On column D "Status"


Once the files is copied. Column D Status will stated "Copied"
or else will "error"? <-- mean tht entire row will be untouched and file not copied?

column Acolumn bcolumn ccolumn d
Row 1File NameSource PathDestination Path (Copy)Status
Row 224.PDFC:\Users\xxx\Desktop\MasterPath\Route 13C:\Users\xxx\Desktop\Saved Folder\70401Copied or error
Row 33.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70401
Row 4211.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70401
Row 5109.PDFC:\Users\xxx\Desktop\MasterPath\Route 16C:\Users\xxx\Desktop\Saved Folder\70409
Row 6103.PDFC:\Users\xxx\Desktop\MasterPath\Route 19C:\Users\xxx\Desktop\Saved Folder\70409

<tbody>
</tbody>












In that case try
Code:
Sub CopyFile()

    Dim Cl As Range
    Dim Fle As String
    
    
    For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
        Fle = ""
        If Dir(Cl.Offset(, 1).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 1).Value
        On Error Resume Next
        Fle = Dir(Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value)
        On Error GoTo 0
        If Fle = "" Then
            FileCopy Cl.Value & "\" & Cl.Offset(, -1).Value, _
                Cl.Offset(, 1).Value & "\" & Cl.Offset(, -1).Value
        End If
    Next Cl
    
End Sub
[/QUOTE]
 
Last edited:
Upvote 0
Try this
Code:
Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname)
        DestFle = Dir(Cl.Offset(, 2).Value & "\" & Fname)
        If Len(SrcFle) > 0 And Len(DestFle) = 0 Then
            FileCopy Cl.Offset(, 1).Value & "\" & Fname, _
                Cl.Offset(, 2).Value & "\" & Fname
            Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
        ElseIf Len(SrcFle) = 0 Then
            Cl.Offset(, 3).Value = "File not found"             'File was not found in source folder
        ElseIf Len(DestFle) > 0 Then
            Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
        End If
    Next Cl
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,217
Members
448,554
Latest member
Gleisner2

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