Copy and rename files without overwriting files

[miguel78]

Hello,

I need some help to adjust this code found on the internet.

I would like that whenever I run the code, new files on the destination folder are never overwritten. The solution seems easy, but I tried a lot and I'm inexperienced in VBA. Please help me.

File attached.

Thank you.

[/COLOR]<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub gerafiles()
    Dim src As String, dst As String, fl As String
    Dim rfl As String
    Dim lngMyRow As Long
    Dim lngLastRow As Long
        
    Application.ScreenUpdating = True
    
    lngLastRow = Range("B:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    'Source directory
    src = Range("B3")
    'Destination directory
    dst = Range("D3")
    For lngMyRow = 6 To lngLastRow
        'File name
        fl = Range("B" & lngMyRow)
        'Rename file
        rfl = Range("D" & lngMyRow)
        On Error Resume Next
        FileCopy src & "\" & fl, dst & "\" & rfl
        
        On Error GoTo 0
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
    MsgBox "OK"
    
End Sub</code>[COLOR=#333333]

 

[Tim_Excel_]

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Sub gerafiles()
    Dim src As String, dst As String, fl As String
    Dim rfl As String
    Dim lngMyRow As Long
    Dim lngLastRow As Long
        
    Application.ScreenUpdating = True
    
    lngLastRow = Range("B:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    'Source directory
    src = Range("B3")
    'Destination directory
    dst = Range("D3")
    For lngMyRow = 6 To lngLastRow
        'File name
        fl = Range("B" & lngMyRow)
        'Rename file
        rfl = Range("D" & lngMyRow)
        On Error Resume Next
[B]If Dir(""&dst&"\"&rfl&"") <code><> "" Then
Next lngMyRow </code>[/B]
[B]Else[/B]        
FileCopy src & "\" & fl, dst & "\" & rfl
        
        On Error GoTo 0
    Next lngMyRow
    
    Application.ScreenUpdating = True
    
    MsgBox "OK"
[B]End if[/B]    
End Sub</code>

Try this.
Make sure you make some backups before fiddling around with this, or you might lose important data!
This code should check if the file already exists, and if so skip saving that file and go to the next one