This script moves files from one place to another based on matching the folder name within the file name.

Set objFSO = CreateObject("Scripting.FileSystemObject")

srcPath = objFSO.getAbsolutePathName(".")
tgtPath = "D:"

  Set objsrc = objFSO.GetFolder(srcPath)
  Set objtgt = objFSO.GetFolder(tgtPath)

i = 0

  For Each tgt In objtgt.subFolders
      For Each src In objsrc.Files

 If inStr(src.Name,tgt.Name) Then
 
  objFSO.copyFile src.Path, tgt.Path & "", True
  i = i + 1
 If objFSO.FileExists(tgt.Path & "" & src.Name) Then
  objFSO.DeleteFile src.Path
 End If
 End If

   Next
   Next 

Set objShell = Wscript.CreateObject("Wscript.Shell")
objShell.LogEvent 0, i & " files moved."