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

[harky]

	column A	column B	column C
Row 1	File Name	Source Path	Destination Path (Copy)
Row 2	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 13	C:\Users\xxx\Desktop\Saved Folder\70401
Row 3	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 16	C:\Users\xxx\Desktop\Saved Folder\70401
Row 4	70401.PDF	C:\Users\xxx\Desktop\MasterPath\Route 19	C:\Users\xxx\Desktop\Saved Folder\70401
Row 5	70409.PDF	C:\Users\xxx\Desktop\MasterPath\Route 16	C:\Users\xxx\Desktop\Saved Folder\70409
Row 6	70409.PDF	C:\Users\xxx\Desktop\MasterPath\Route 19	C:\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

 

[Fluff]

Simply add the _ to the file name in col A so that it looks like 859_ or 859A_

 

[harky]

Thanks!

Simply add the _ to the file name in col A so that it looks like 859_ or 859A_

 

[harky]

Thanks!

somehow i notice mistakes at source path & destination folder

I had filename like.

From the data which i had on hand, i only able to list out the first part (the one in red).

859_1_5_11111.xxx
859A_1_4_22222.xxx
859_1_10_33333.xxx
859A_1_9_44444.xxx

The code only able to copy first 2 file, not the rest although they are copied from diff source path and had diff filename in whole.

Can the destination folder part be change? as long the fullname is not exist. File can be copied?

Simply add the _ to the file name in col A so that it looks like 859_ or 859A_

 

[Fluff]

How about

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    Dim Cnt As Long
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
        If Len(SrcFle) > 0 Then
            Cnt = 0
            Do While Len(SrcFle) > 0
                Cnt = Cnt + 1
                SrcFle = Dir
            Loop
            If Cnt = 1 Then
                SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
                If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
                DestFle = Dir(Cl.Offset(, 2).Value & "\" & SrcFle & "*")
                If Len(DestFle) = 0 Then
                    FileCopy Cl.Offset(, 1).Value & "\" & SrcFle, _
                        Cl.Offset(, 2).Value & "\" & SrcFle
                    Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
                ElseIf Len(DestFle) > 0 Then
                    Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
                End If
            Else
                Cl.Offset(, 3).Value = "More than 1 file found"             'File was not found in source folder
            End If
        Else
            Cl.Offset(, 3).Value = "Source file doesn't exist"
        End If
    Next Cl
    
End Sub

 

[harky]

Thanks! Working now....

How about

Sub CopyFile()

    Dim Cl As Range
    Dim SrcFle As String
    Dim DestFle As String
    Dim Fname As String
    Dim Cnt As Long
    
    
    For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
        Fname = Cl.Value
        SrcFle = ""
        DestFle = ""
        SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
        If Len(SrcFle) > 0 Then
            Cnt = 0
            Do While Len(SrcFle) > 0
                Cnt = Cnt + 1
                SrcFle = Dir
            Loop
            If Cnt = 1 Then
                SrcFle = Dir(Cl.Offset(, 1).Value & "\" & Fname & "*")
                If Dir(Cl.Offset(, 2).Value, vbDirectory) = "" Then MkDir Cl.Offset(, 2).Value
                DestFle = Dir(Cl.Offset(, 2).Value & "\" & SrcFle & "*")
                If Len(DestFle) = 0 Then
                    FileCopy Cl.Offset(, 1).Value & "\" & SrcFle, _
                        Cl.Offset(, 2).Value & "\" & SrcFle
                    Cl.Offset(, 3).Value = "Copied"                     'File was copied to new folder
                ElseIf Len(DestFle) > 0 Then
                    Cl.Offset(, 3).Value = "File Exists"                'File already exists in destination folder
                End If
            Else
                Cl.Offset(, 3).Value = "More than 1 file found"             'File was not found in source folder
            End If
        Else
            Cl.Offset(, 3).Value = "Source file doesn't exist"
        End If
    Next Cl
    
End Sub

 

[Fluff]

You're welcome & thanks for the feedback