Help:) To find files and copy to new location - filesystem object.

Hello,

I wonder if anyone can help me with a macro.

I have an excel sheet listing product data including image filenames. So far I have a macro which reads the list of filenames then checks a file location to see if the file exists. If the file exists then "Yes" is entered and if not then "No" is entered to the appropriate data row.

I'd like to finish this by copying the file if it exists and place it in a new location, but I don't have a clue where to start with this one.

Here is the code I have so far.
**************************
' Sub Check_File_Existance()
Dim lRow&, cRow&, ImageName$
Dim WS_Csv As Worksheet

Application.ScreenUpdating = False

' to work on activesheet
Set WS_Csv = ActiveSheet

With WS_Csv
' decide last row of CSV
lRow = .Cells(Rows.Count, "A").End(xlUp).Row

For cRow = 2 To lRow
ImageName = .Cells(cRow, "B").Value

' check if image exists or not
If Dir("D:\www\mywebsite.uk\image\data\" & ImageName) = vbNullString Then
.Cells(cRow, "AA") = "No"
Else
.Cells(cRow, "AA") = "Yes"
End If
Next
End With

Application.ScreenUpdating = True

End Sub
**********************************

I would like the files which exist to be copied to D:\www\mywebsite.uk\image\data\filesfound\

Any help or guidance would be appriciated, thanks.

Hi OllieB,

Many thanks for your quick reponse, can you help me a little further?

Do I use the code you have provided in place of the code I already have or do I add your code after the existing macro?

Regards

CosyDan6

I managed to finally find out why the code didn't work for me.

I simply changed "With ThisWorkbook.ActiveSheet" to "With ActiveSheet"

Thanks