Mover archivos de una carpeta a otra desde excel con macros

Despues de mucha de la ayuda que me da esta página, creo que es hora de aportar algo. Buscando por la web encontre este codigo que espero que les sirva de mucho.

Saludos

Sub MoverArchivos()
'
'Antes de correr la macro, elije las celdas que tengan la ruta
'del nombre actual, es decir a partir de A2
Dim NombreNuevo As String
Dim NombreAnterior As String
'
'Si no encuentra algún archivo, continuará con el siguiente
'
On Error Resume Next
For Each Celda In Selection
    NombreAnterior = Celda.Value
    'El dato del nombre nuevo y la carpeta nueva será la columna G, especificado con 6
    NombreNuevo = Celda.Offset(0, 6).Value
    Name NombreAnterior As NombreNuevo
Next Celda
'
On Error GoTo 0
'
End Sub[/PHP]

Ejemplo cambio de Ruta.zip