Копирование файла из одной папки в другую папку с названием того файла - VBA

Формулировка задачи:

Здравствуйте. Задача: Есть список названий картинок в таблице Excel. (1.jpg, 2.jpg......) 1. Нужно скопировать картинку из папки А с названием 1.jpg в папку 1, предварительно создав папку. 2. Нужно скопировать картинку из папки А с названием 2.jpg в папку 2, предварительно создав папку. 3. и т.д. Написал кусок, который создает папки с названиями, но не могу настрочить кусок кода, как реализовать поиск по названию и ее копирование в соответствующую папку. Подскажите пожалуйста.

Sub MDir()
On Error Resume Next
For Each oCell In Range([B1], [A65536].End(xlUp))
If Not IsEmpty(oCell) Then MkDir "D:\папка1\фото\" & oCell
Next
End Sub

Решение задачи: «Копирование файла из одной папки в другую папку с названием того файла»

textual
                            Листинг программы 
                        

                            Sub eedfedf()
    
    Dim path As String
    Dim file As String
    Dim cnt As Integer
    Dim name As String
    Dim fso As Object
    
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    path = "C:\TEST\"
    
    file = Dir(path)
    
    While file <> ""
        
        'get name of folder
        name = Mid(file, 1, InStrRev(file, ".") - 1)
        
        'create folder
        MkDir path & name
        
        fso.CopyFile path & file, path & name & "\" & file
        
        file = Dir
        cnt = cnt + 1
    Wend
   
End Sub
                        