Оператор FileCopy поможет:
FileCopy полный_путь_к_файлу, путь_вставки_с_именем_файла
Всего одна строка, но перед ней... Нужно копировать много файлов да по разным адресам, обойти ошибки, получить имя файла из полного пути...
' копирование файлов из списка по указанным папкам'
' строка 1 - "шапка", ст.A - имена файлов, ст. B - путь копирования'
' при отсутствии папки для копирования папка создается'
' Формируется список: файлов, которые не найдены; созданных папок'
' список выводится в столбцы D:F, информация: строка, папка/файл, путь'
Sub CopyFiles()
Dim aPath(), aErr()
Dim sFName As String
Dim lRw As Long
Dim i As Long, k As Long, n As Long
With ActiveSheet ' или другой лист: With WorkSheets("ссылки")'
lRw = .Cells(.Rows.Count, 1).End(xlUp).Row: If lRw < 2 Then Exit Sub
aPath = .Range("A1:B" & lRw).Value ' имена и пути в массив'
End With
ReDim aErr(1 To lRw * 2, 1 To 3) ' массив для ошибок'
Application.ScreenUpdating = False
For i = 2 To lRw
If Dir(aPath(i, 2), vbDirectory) = "" Then ' проверяем наличие папки для копирования'
k = k + 1: aErr(k, 1) = i
aErr(k, 2) = "папка": aErr(k, 3) = aPath(i, 2)
MkDir aPath(i, 2)
End If
If Dir(aPath(i, 1), vbDirectory) = "" Then ' файла нет'
k = k + 1: aErr(k, 1) = i
aErr(k, 2) = "файл": aErr(k, 3) = aPath(i, 1)
Else ' файл есть'
sFName = Mid$(aPath(i, 1), InStrRev(aPath(i, 1), "\")) ' извлекаем \имя_файла'
n = n + 1: FileCopy aPath(i, 1), aPath(i, 2) & sFName ' копируем файл'
End If
Next i
If k > 0 Then ActiveSheet.Cells(2, 4).Resize(k, 3).Value = aErr ' ошибки на лист'
Application.ScreenUpdating = True
MsgBox "Копировано файлов: " & n & Chr$(10) & "Ошибок: " & k, 64, "OK"
End Sub

Примечание: наличие диска не проверяется. Если диск (например F) отсутсствует, получим ошибку. Если такое не исключается, нужно дописать проверку:
If Dir(Split(aPath(i, 2), ":")(0), vbDirectory) = "" Then
...