¿Cómo manejar (copiar y pegar) archivos externos desde una Macro VBA?

Ok. Lo primero es insertar un modulo y en este modulo pones esto:

Option Explicit
Private Const MAX_PATH = 64
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFind As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private TotSize As Long
Private NumSubdirs As Long
Private NumArxius As Long
Public TA As Long
Const MiDir As String = "C:\CARPETA 1\"
Dim MATRIZ() As String
Dim NL As String
Sub listar_archivos()
Dim i As Integer
Dim F As Long
On Error GoTo Err
ChDir MiDir
'4c7569735f50
inf MiDir
If TA = 0 Then MsgBox "No se encontraron archivos en carpeta " & MiDir, vbCritical: NL = "": Exit Sub
MATRIZ = Split(NL, "#")
Application.ScreenUpdating = False
Range("A:A").Clear
F = Application.WorksheetFunction.CountA(Range("a:a"))
For i = LBound(MATRIZ) + 1 To UBound(MATRIZ) - 1
F = (F + 1)
Range("a" & F) = Trim(MATRIZ(i))
DoEvents
Next
Err: If Err.Number = 76 Then MsgBox "No se encontro la carpeta " & MiDir
NL = ""
Erase MATRIZ
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub
Private Function inf(miPath As String) As Long
Dim atribarx As Long, TotSize As Long
Dim valor1 As Long, valor2 As Long
Dim InfoTd As WIN32_FIND_DATA
Dim NomArxiu As String
On Error Resume Next
If Right(miPath, 1) <> "\" Then miPath = miPath & "\"
TotSize = 0
NumSubdirs = 0
NumArxius = 0
valor1 = 0
valor2 = True
valor1 = FindFirstFile(miPath & "*.*", InfoTd)
Do
NomArxiu = InfoTd.cFileName
atribarx = InfoTd.dwFileAttributes
If Left(NomArxiu, 1) <> "." Then
If atribarx And FILE_ATTRIBUTE_DIRECTORY Then
NumSubdirs = NumSubdirs + 1
Else
NumArxius = NumArxius + 1
End If
End If
valor2 = FindNextFile(valor1, InfoTd)
If valor2 > 0 Then NL = (NL & InfoTd.cFileName & "#")
Loop Until valor2 = 0
FindClose (valor1)
DoEvents
TA = NumArxius
DoEvents
DoEvents
TotSize = 0
NumSubdirs = 0
NumArxius = 0
End Function
Sub copiar_archivo()
Dim a As Long
Dim i As Long
a = Application.WorksheetFunction.CountA(Range("A:A"))
If a = 0 Then Exit Sub
Dim actual As String
Dim copia As String
Dim archivo As FileSystemObject
ChDir "C:\"
ChDir MiDir
For i = 1 To a
copia = MiDir & Range("A" & a)
actual = "C:\CARPETA 2\" & Range("A" & i)
Set archivo = New FileSystemObject
archivo.CopyFile copia, actual, True
Set archivo = Nothing
Next
MsgBox "Copiados", vbInformation
End Sub

Luego desde el editor de vbasic ve al menu herramientas/referencias...
Debes activar la referencia : "microsoft scripting runtime"

El tema funciona asi:

En la constante midir desde definior el path de la carpeta que contiene los archivos a copiar, en este caso de ejemplo es carpeta 1, tu debes modificarlo
luego ejecutas el macro listar_archivos, este macro te devolvera la lista de todos los archivos de la carpeta y los pondra
en la columna A ( te sugiero lo hagas en un hoja en blanco), una vez listado los archivos tu defines cual decides copiar, los que no deseas copiar debes eliminar la linea
no deben haber lineas en blanco entre un archivo y otro o no se ejecutara en forma completa.
Una vez depurada la lista, solo corres el macro copiar_archivo, importante es que en este ultimo macro definas el path de la carpeta que contedra las copias en caso de este ejemplo se denomina carpeta 2