Maybe trial using movefile to see if it's any quicker as well...
Function sMoveFiles(xRg As String, xSPathStr As Variant, xDPathStr As Variant) As Boolean
Dim fso As Object, xF As Object, xFS As Object, TempSplit As Variant
Set fso = CreateObject("Scripting.FileSystemObject")
Set xFS = fso.GetFolder(xSPathStr)
For Each xF In xFS.Files
TempSplit = Split(xF.Name, "_")
If TempSplit(0) = CStr(xRg) Then
'copy source file to destination folder, overwrite file true/false
fso.moveFile xSPathStr & xF.Name, xDPathStr & xF.Name ', True
'remove original file
'Kill xSPathStr & xF.Name
'fso.deletefile (xSPathStr & xF.Name), False
sMoveFiles = True
Exit Function
End If
Next xF
Set xFS = Nothing
Set fso = Nothing
End Function
Dave