Something like this will work:

Sub test()

Dim i As Long
Dim arr

'looping through an array is a bit faster
arr = Range(Cells(4), Cells(100, 4))

For i = 1 To UBound(arr)
'this presumes the full path is in range in column D
FileCopy arr(i, 1), "C:\My Documents\CopyData\" & FileFromPath(arr(i,
1))
Next i

End Sub


Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean) As String

On Error GoTo ERROROUT

FileFromPath = Right$(strFullPath, _
Len(strFullPath) - _
InStrRev(strFullPath, "\", , vbBinaryCompare))

If bExtensionOff Then
FileFromPath = Left$(FileFromPath, _
InStr(1, FileFromPath, ".", vbBinaryCompare) - 1)
End If

Exit Function
ERROROUT:

'or return the provided strFullPath
FileFromPath = vbNullString

End Function


RBS


"Aaron" wrote in message
...
I have a column with a path for every record in Column D. Example
\\TEST\MyDoc\Pic.bmp
How do I by record copy each file at the path listed to a new folder in My
Docs called (CopyData)?

Thanks,
AJ