2つの列のANDで一致したファイルの移動

質問

とあるシートのB列の値かつAM列の値と、とあるフォルダ内にあるファイルの名称が部分一致したときに、
そのファイルを移動先のフォルダへと移動させるVBAを教えていただけないでしょうか?

この内容のVBAを作ったのですが、エラーが出てしまいます（エラーの箇所はコード内に示している）、またこのエラーが影響しているか分からないのですが分別されているのですが上手くいっていません

VBA初心者なのでどうか分かりやすくお教えお願い致します

Sub 分別()

'移動元のフォルダの設定
Const xFrm As String = "C:\before\"

'移動先のフォルダの設定
Const xTo As String = "C:\after\"

'アクティブになっているシートのB列の値かつAM列の値と、C:\before内のファイルの名称が部分一致した時、そのファイルをC:\afterへと移動する
'（（例）B列：M123456、AM列：789、C:\before内のファイル：M123456-789-C12.csv）

Dim i As Long, xFile As String
With ActiveSheet

For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
With .Cells(i, 2)
xFile = Dir(xFrm & "*" & .Value & "*")
Do While xFile <> ""
If xFile Like "*" & .Offset(, 37).Value & "*" Then
Name xFrm & xFile As xTo & xFile
End If
xFile = Dir()
Loop

End With

Next i

End With

'C:\before内に残っているファイルを、C:\after2に移動
Dim fso As Object
Dim MFir As String
Dim SFir As String
Set fso = CreateObject("Scripting.FileSystemObject")

MFir = "C:\before\*.*"

SFir = "C:\after2\"

fso.MoveFile MFir, SFir →ここでエラー出る（実行時エラー53
ファイルが見つかりません）
Set fso = Nothing

MsgBox "終了"

End Sub

回答No.4

masnoske

タイトルを変えて全く同じ質問する意図は何でしょうか？
前回の質問を誤って締め切ってしまったのでしょうか？

回答No.3

kkkkkm

エラーを無くすのでしたら以下のように変更してみてください。
MsgBoxは出すと鬱陶しいので一応コメントにしてます。

'C:\before内に残っているファイルを、C:\after2に移動
Dim fso As Object
Dim MFir As String
Dim SFir As String
Dim buf As String

Set fso = CreateObject("Scripting.FileSystemObject")

MFir = "C:\before\*.*"

SFir = "C:\after2\"

buf = Dir(MFir)
If buf = "" Then
' MsgBox "残っているファイルはありません。", vbInformation
Exit Sub
End If

fso.MoveFile MFir, SFir
Set fso = Nothing

MsgBox "終了"

回答No.2

kkkkkm

No1の補足です。

残っているファイルを移動より前の部分を実行は

Set fso = CreateObject("Scripting.FileSystemObject")
の左のグレーの部分をクリックしてブレークポイント「茶色(色は違うかもしれません)の●が付いてその行が選択された状態」でVBAを実行するとそこでVBAがいったん止まります。

回答No.1

kkkkkm

C:\before\にファイルが無いとそのエラーになります。
残っているファイルを移動より前の部分を実行してその時にC:\before\にファイルがあるかどうか確認してください。