Копирование файлов по списку

[AlexanderJin]

Добрый день. Помогите, пожалуйста. Нашёл макрос, который копирует файлы по указанной директории, но для моей задачи не совсем подходит, т.к. у меня огромное количество файлов (>1000), которые нужно рассовать по разным директориям. Не могу прописать в макросе, что директории файлов нужно брать из столбца A, а директории для копирования этих файлов нужно брать из столбца B.
Макрос:

Sub Copy_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String, sNewFileName As String
 
    sFileName = Range("a1")    'имя исходного файла
    sNewFileName = Range("b1")    'имя файла в конечной директории
    If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
    
    'копируем файл
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Copy sNewFileName
 
    MsgBox "Файл скопирован", vbInformation, "ааа"
End Sub

[IgorGO]

при активном листе с данными выполните этот макрос

Sub CopyAasB()
  Dim r As Long, s As String
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Dir(Cells(r, 1)) <> "" Then
      If Dir(Cells(r, 2)) <> "" Then Kill Cells(r, 2)
      FileCopy Cells(r, 1), Cells(r, 2)
    Else
      s = s & Chr(10) & Cells(r, 1)
    End If
  Next
  If s <> "" Then MsgBox "Not Copied:" & s
End Sub

[AlexanderJin]

Сообщение от IgorGO

при активном листе с данными выполните этот макрос

Sub CopyAasB()
  Dim r As Long, s As String
  For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Dir(Cells(r, 1)) <> "" Then
      If Dir(Cells(r, 2)) <> "" Then Kill Cells(r, 2)
      FileCopy Cells(r, 1), Cells(r, 2)
    Else
      s = s & Chr(10) & Cells(r, 1)
    End If
  Next
  If s <> "" Then MsgBox "Not Copied:" & s
End Sub

отлично, всё работает. спасибо!