Copia muchos archivos a variadas carpetas según el nombre del archivo a copia y carpeta destino

Tengo las siguientes dudas:
¿Todos los archivos inician con 4 dígitos?
Las carpetas deben iniciar con 4 dígitos, en tu ejemplo pusiste “carpeta donde se debe copiar: 3415-monitor”, ¿pero esto significa que habrá una carpeta por archivo?, o en una carpeta 3415, ¿se van a copiar todos los archivos que empiecen con 3415?
Si en un carpeta 3415, se van a copiar todos los archivos entonces realiza las instrucciones anexas.
Instrucciones
1. Abre una hoja de excel y guárdala con el nombre copiaarchivos
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. En la macro hay un dato que se llama carpetaorigen, aquí tienes que poner el directorio en donde se encuentran los archivos
6. También tienes que cambiar la carpetadestino por la carpeta donde inician los directorios con dígitos.
7. Para ejecutarla presiona F5
Notas:
En el archivo de Excel llamado copiaarchivos, te va a poner en la columna A, la Lista de los archivos. En la columna B, te va a poner si se copió el archivo o tuvo error al momento de realizar la copia, el problema principal, es que no encuentre la carpeta destino.

'*******Macro******
Sub listar_archivos()
'Por.Dam
'Lee archivos de un directorio y los copia en un destino
On Error Resume Next
carpetaorigen = "C:\Documents and Settings\DAMOR\Mis documentos\docs\Soporte expertos\archivos\"
carpetadestino = "C:\Documents and Settings\DAMOR\Mis documentos\docs\Soporte expertos\archivos\"
Set navegador = CreateObject("shell.application")
ChDir carpetaorigen
archi = Dir("*.*")
Workbooks("copiaarchivos").Activate
Range("A:B").Clear
Range("A1").Select
Do While archi <> ""
    ActiveCell.Value = archi
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = celda
    archi = Dir()
Loop
Dim archori, archdes As String
ufila = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
lin = 1
Do While lin <= ufila
    archori = carpetaorigen & Cells(lin, 1).Value
    numcarpeta = Left(Cells(lin, 1).Value, 4)
    archdes = carpetadestino & numcarpeta & "\" & Cells(lin, 1).Value
    FileCopy archori, archdes
    If Err.Number = 0 Then
        'El archivo fue copiado
        Cells(lin, 2).Value = ("Copiado")
    Else
        Cells(lin, 2).Value = ("Copia con Error " & Err.Number)
        Err.Number = 0
    End If
    lin = lin + 1
Loop
End Sub
'******Macro*******

Saludos.Dam
No olvides cerrar la pregunta

Gracias por tu respuesta.

Aclaro algunos puntos: comienzan con 4 y algunos con 5 dígitos, pero no se repiten y las carpetas de la misma forma es decir 4 y 5 dígitos es decir un correlativo, exite un solo numero 3415 tanto en la carpeta como en los archivos

al final de los números tiene un guion y el nombre de equipo que son distintos.

La carpeta de origen esta c:\pendientes

La carpeta de destino esta en disco de red k:\\transfer\equipos

y dentro de equipos están las 5000 carpetas distintas.

espero que no sea muy complejo, y nuevamente muchas gracias por tu pronta respuesta.

1. No me queda clara la relación entre el archivo y la carpeta, me podrías poner varios ejemplos reales de 5 archivos de 4 dígitos y a cuál o cuáles carpetas deben ir, y otros 5 ejemplos de archivos de 5 dígitos y a cuál o cuáles carpetas deben ir, y si puedes poner más ejemplos, mejor, tienes como 5,000 ejemplos.

2. En cuanto a las carpetas origen y destino te actualizo el nombre en el código de la macro.

3. Actualmente puedes copiar un archivo desde la carpeta c:\pendientes a la carpeta k:\\transfer\equipos, desde windows.

Buenos días

en Carpeta C:\pendientes tengo los siguientes ejemplos

3415-monitor- marca xxx

3416-maquina de anestesia- marca yyyy

4018- mesa quirúrgica- marca zzzz

17185-columna de gases- marca AAAAA

24132- equipos de rayos-marcaHHHHH

copiar a la carpetas que corresponda

k:\\transfer\equipos\3415-monitor

k:\\transfer\equipos\3416-maquina de anestesia

k:\\transfer\equipos\4018- mesa quirúrgica

k:\\transfer\equipos\17185-columna de gases

k:\\transfer\equipos\24132- equipos de rayos

Como se observa las carpetas tiene la correspondencia con los archivos en los números.

Realiza las instrucciones que te envié anteriormente y copia la siguiente macro.

'*******Macro******
Sub listar_archivos()
'Por.Dam
'Lee archivos de un directorio y los copia en un destino
On Error Resume Next
carpetaorigen = "C:\Pendientes\"
carpetadestino = "k:\\transfer\equipos\"
Set navegador = CreateObject("shell.application")
ChDir carpetaorigen
archi = Dir("*.*")
Workbooks("copiaarchivos").Activate
Range("A:D").Clear
Range("A1").Select
Do While archi <> ""
    ActiveCell.Value = archi
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = celda
    archi = Dir()
Loop
Dim archori, archdes As String
ufila = Range("A" & Rows.Count).End(xlUp).Row
Range("A1").Select
lin = 1
Do While lin <= ufila
    archori = carpetaorigen & Cells(lin, 1).Value
    celda = Cells(lin, 1).Value
    caracter = InStr(7, celda, "-")
    numcarpeta = Left(Cells(lin, 1).Value, caracter - 1)
    archdes = carpetadestino & numcarpeta & "\" & Cells(lin, 1).Value
    FileCopy archori, archdes
    If Err.Number = 0 Then
        'El archivo fue copiado
        Cells(lin, 2).Value = ("Copiado")
    Else
        Cells(lin, 2).Value = ("Copia con Error " & Err.Number)
        Err.Number = 0
        Cells(lin, 3).Value = archori
        Cells(lin, 4).Value = archdes
    End If
    lin = lin + 1
Loop
End Sub
'******Macro*******

En el archivo de excel te deja esto:

A B C D
Archivo a copiar Copiado o Error archivo origen archivo destino

Saludos. DaM
No olvides cerrar la pregunta

Hola

Probé la macro , tuve que modificar el camino (estoy en mi casa), pero copia los archivos

en el directorio equipos.

en el archivo excel me indica:

3415 - MONITOR.pdf
Copia con Error 5
C:\Pendientes\3415 - MONITOR.pdf
C:\transfer\equipos\\3415 - MONITOR.pdf

3416 - maquina de anestesia.pdf
Copia con Error 5
C:\Pendientes\3416 - maquina de anestesia.pdf
C:\transfer\equipos\\3416 - maquina de anestesia.pdf

No se que puede faltar

Lo que sucede, es que me habías dicho que los archivos eran similares a este:

3416-maquina de anestesia- marca yyyy

La macro necesita que el nombre de archivo tenga 2 guiones, en el ejemplo, "anestesia-marca", el guión entre anestesia y marca, me ayuda para identificar el nombre del directorio completo: que sería : 3416-maquina de anestesia.

Tu archivo ejemplo “3416 - maquina de anestesia.pdf”, no trae el segundo guión, no se puede identificar el nombre completo del directorio.
Entiendo que necesitas que con el puro número “3416” busque la carpeta “3416 - maquina de anestesia”.
Confírmame si los archivos pueden venir o no con el segundo guión, para revisar otra opción.
Saludos. DaM

3416-maquina de
anestesia marca yyyy-.pdf
Copia con Error 76
C:\Pendientes\3416-maquina de anestesia
marca yyyy-.pdf
E:\transfer\equipos\3416-maquina de
anestesia marca yyyy\3416-maquina de anestesia marca yyyy-.pdf
3417-maquina de anestesia marca yyyy-.pdf
Copia con Error 76
C:\Pendientes\3417-maquina de anestesia marca yyyy-.pdf
E:\transfer\equipos\3417-maquina de anestesia marca yyyy\3417-maquina de
anestesia marca yyyy-.pdf

Le puse guión entre el numero y final.

pero no copia

Pero tienes que poner el guión así:

3417-maquina de anestesia-marca yyyy.pdf

3416-maquina de anestesia-marca yyyy.pdf

El segundo guión va como en los ejemplos que me enviaste:

3415-monitor- marca xxx
3416-maquina de anestesia- marca yyyy
4018- mesa quirúrgica- marca zzzz
17185-columna de gases- marca AAAAA
24132- equipos de rayos-marcaHHHHH
Copiar a la carpetas que corresponda
k:\\transfer\equipos\3415-monitor
k:\\transfer\equipos\3416-maquina de anestesia
k:\\transfer\equipos\4018- mesa quirúrgica
k:\\transfer\equipos\17185-columna de gases
k:\\transfer\equipos\24132- equipos de rayos

Sigo trabajando en la macro para hacer la copia con tan solo el número, ¿pero necesito que me confirmes si después del número va un guión?

También dime si puede haber un archivo 2222-monitor y otro archivo así 2222-accesorio, tenemos dos archivos que tienen el mismo número pero después del guión el nombre cambia.

hola

daM

probé lo que indicaste, pero no resulta

3416-maquina de
anestesia- marca yyyy.pdf
Copia con Error 76
C:\Pendientes\3416-maquina de anestesia-
marca yyyy.pdf
E:\transfer\equipos\3416-maquina de
anestesia\3416-maquina de anestesia- marca yyyy.pdf

respecto a las preguntas: Siempre va un guion tanto en la carpeta como en los archivos

respeto a los archivos los números son como la identificación personal,es único, pero si a futuro existirán otros archivos

Ejemplo:

al inicio de la carpeta tenemos el equipo, en este caso 3416-maquina de anestesia-marc xxx

a futuro tendremos 3416-informe reparación 30_09_12 ó 3416-mantención preventiva 05_10_12.

por lo tanto después del guion cambia.

Gracias

Pero La búsqueda de la carpeta es correcta:

C:\Pendientes\3416-maquina de anestesia- marca yyyy.pdf
E:\transfer\equipos\3416-maquina de anestesia\3416-maquina de anestesia- marca yyyy.pdf

Tienes que crear la carpeta E:\transfer\equipos\3416-maquina de anestesia

Por favor, revisa que exista la carpeta y vuelve a ejecutarla.

Si siguen con la regla: número – carpeta – archivo, no debes tener problema con está macro en el futuro.
Saludos. DaM
Por favor, si no tienes problemas, puedes cerrar la pregunta