1. Подключите библиотеку: Tools - References... - Microsoft Scripting Runtime.
2. В самом вверху модуля вставьте эти строки:
Option Explicit
Option Compare Text
Option Base 1
3. Макрос смотрит не четыре символа в начале имени файла, а ищет в начале имени все данные из ячейки.
4. Макрос сделан для виндоуса. Для мака нужно делать другой макрос.
Макрос
Sub Макрос()
Dim fso As Scripting.FileSystemObject
Dim папка As Scripting.Folder, файл As Scripting.File
Dim ИмяИсхПапки As String, ИмяНовойПапки As String
Dim НачалоИмени As String, FN_new As String
'1. Записываем в переменные полные имена (путь + имя) папок, с которыми надо работать.
' Записываем в переменные, чтобы было удобнее писать и читать код.
' На конце полного имени папки не указывайте слеш.
ИмяИсхПапки = "D:\Папка-источник"
ИмяНовойПапки = "D:\Папка-результат"
'2. Создание объекта, который умеет работать с папками и файлами.
Set fso = New Scripting.FileSystemObject
'3. Присваиваем папке, которую надо просмотреть, имя "папка".
' Далее в коде будем обращаться к этой папке по этоиму имени.
Set папка = fso.GetFolder(ИмяИсхПапки)
'4. Записываем в переменную начало имени файла, который нужно переместить в другую папку.
' Записываем в переменную, чтобы было удобнее читать и писать код.
НачалоИмени = Sheets("Лист1").Range("A1").Value
'5. Перемещение файлов.
' Просматриваем все файлы внутри папки.
For Each файл In папка.Files
' Если у файла нужное начало имени.
' * означает ноль или любое количество любых символов.
If файл.Name Like НачалоИмени & "*" Then
' Записываем в переменную новое полное имя для файла.
' Записываем в переменную, чтобы удобнее читать и писать код.
FN_new = ИмяНовойПапки & "\" & файл.Name
' Удаление имеющегося файла.
If fso.FileExists(FN_new) Then
fso.DeleteFile FN_new
End If
' Перемещение файла в нужную папку.
файл.Move FN_new
End If
Next файл
'6. Сообщение.
MsgBox "Готово.", vbInformation
End Sub