Help on Moving file to another folder, using partial filename

[Xtremedesign]

This should do it...

Sub sMoveFiles(xRg As Range, xSPathStr As Variant, xDPathStr As Variant)
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
fso.CopyFile xSPathStr & xF.Name, xDPathStr & xF.Name, True
Kill xSPathStr & xF.Name
End If
Next xF
Set xFS = Nothing
Set fso = Nothing
End Sub

When I select more than 1 cell I get an error "mismatch". That's only when I click on more that one filename in the cell. Anyway around that? Thanks