¿Como hacer que una macro ejecute un .bat para copiar archivos a otra carpeta?

Al correr la macro se ejecuta bat bien renombra los archivos y despues me manda el error: se ha producido el error 53 en tiempo de ejecucion: archivo no encontrado.

Le doy Depurar y me subraya la linea de la instruccion. FileCopy co & archivo, cd & archivo

En I10, tengo la ruta de donde estan los archivos txt

En I13: tengo la ruta a donde quiero que se copien los archivos

Las dos rutas terniman con \ y son en la unidad D

¿La carpeta deseada la quieres poner en una celda? O la quieres capturar, ¿qué te aparezca la ventana de diálogo para seleccionar una carpeta y escoger la carpeta deseada? ¿O quieres que la macro la encuentre en base a ciertos criterios?

Hola,

*se puede poner el nombre de la carpeta en una celda

Mil gracias!!

Con esta macro copias los archivos de la carpeta origen a la carpeta destino

En la celda "A1" pon la carpeta origen, ejemplo: C:\trabajo\

En la celda "A2" pon la carpeta destino, ejemplo: C:\trabajo\varios\

En esta instrucción puedes elegir cuáles archivos copiar, en el ejemplo puse solamente los archivos que tienen extensión xls*, pero si quieres que se copien todos puedes poner:

archivo = Dir("*.*")

NOTA: Con la macro no ha necesidad de ejecutar el .bat

Sub copiararchivos()
'Por.DAM
    Dim archivos As New Collection
    co = Range("A1")
    cd = Range("A2")
    ChDir co
    archivo = Dir("*.xls*")
    Do While archivo <> ""
        FileCopy co & archivo, cd & archivo
        archivo = Dir()
    Loop
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Hola,

ya lo intente, pero como mi macro primero llama a un bat para renombrar los archivos empieza con

sub nombredelamacro ()

declaro las variables

llamo al bat con CmdLine

y termina con 

MsgBox CmdLine
Bat = Shell(CmdLine, 1)
despues de esto pongo lo que me comentas, al ejecutar la macro me manda el error:

ERROR DE COMPILACION:

SE ESPERABA END SUB

que hago?

mil gracias 

Puedes hacer lo siguiente.

1. Ejecutas la macro que renombra archivos, esa dices que está bien.

2. Ejecutas la macro que te envié.

Pon completa la macro1 que tienes para renombrar archivos y yo junto las 2 macros y te envíe el código completo. Algo te falto en la unión de las macros, o tal vez, sólo te faltó poner la última instrucción :

End Sub

Revísalo y me comentas

Si te funciona no olvides valorar la respuesta.

de acuerdo:

Sub INFINIT()
'
' INFINIT Macro
'

'
Dim AÑO As String, MES As String, DIA As String, FECHA As Date, COL As Long
A = Range("F12").Value
M = Range("G12").Value
D = Range("H12").Value
A = Trim(A)
M = Right("0" + Trim(M), 2)
D = Right("0" + Trim(D), 2)
A2 = Right(A, 2)
PW = Choose(Val(M), "Enero", "Febreo", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
MA = Range("G13").Value

'RENOMBRADO DE BASES========================================================

CmdLine = "D:\REPORTE INFINIT\RENOMBRA.bat "
CmdLine = CmdLine + A + M + D
MsgBox CmdLine
Bat = Shell(CmdLine, 1)
'Esto es lo que tu me proporcionaste

Sub copiararchivos()

Dim archivos As New Collection
co = Range("I10")
cd = Range("I13")
ChDir co
archivo = Dir("*.txt*")
Do While archivo <> ""
FileCopy co & archivo, cd & archivo
archivo = Dir()
Loop
End Sub

Mil gracias!!

Si quieres que las macros queden juntas, así:

Sub INFINIT()
'
' INFINIT Macro
    Dim AÑO As String, MES As String, DIA As String, FECHA As Date, COL As Long
    A = Range("F12").Value
    M = Range("G12").Value
    D = Range("H12").Value
    A = Trim(A)
    M = Right("0" + Trim(M), 2)
    D = Right("0" + Trim(D), 2)
    A2 = Right(A, 2)
    PW = Choose(Val(M), "Enero", "Febreo", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre")
    MA = Range("G13").Value
'RENOMBRADO DE BASES========================================================
    CmdLine = "D:\REPORTE INFINIT\RENOMBRA.bat "
    CmdLine = CmdLine + A + M + D
    MsgBox CmdLine
    Bat = Shell(CmdLine, 1)
'Por.DAM
    co = Range("I10")
    cd = Range("I13")
    ChDir co
    archivo = Dir("*.txt*")
    Do While archivo <> ""
        FileCopy co & archivo, cd & archivo
        archivo = Dir()
    Loop
End Sub

Hola,

ahora me sale error en la instruccion:

saludos y mil gracias

FileCopy co & archivo, cd & archivo