Hi,
I created a code to copy files by the partial name of the active cell and it colors the cell when the file is copied successfully.
But now I needed to keep both files if same file name exists in the target folder without overwriting the files.
How do I solve this matter?
Code
Sub Copy_by_keyword()
Dim srcFolder As String
Dim tgtFolder As String
Dim sFilename As String
Dim c As Range
Dim mRange As Range
Dim bBad As Boolean
srcFolder = ("C:\Personal\Reports")
tgtFolder = ("D:\VBA\Trade\")
Set mRange = ActiveSheet.Range("M10:M100").SpecialCells(xlConstants)
For Each c In mRange
sFilename = Dir(srcFolder & "*" & c.Text & "*")
If sFilename = "" Then
c.Interior.ColorIndex = 4
bBad = False 'Here I used this to avoid overwriting but it does not respond'
Else
While sFilename <> ""
FileCopy srcFolder & sFilename, tgtFolder & sFilename
sFilename = Dir()
c.Interior.ColorIndex = 6
Wend
End If
Next c
If bBad Then MsgBox "Files not found"
End Sub
Display More