Duda con macro excel para copiar archivos
Hola a todos
Tengo un problemilla con una macro que estoy haciendo
seria esta
Sub copiar_jpg()
Dim Celda As Excel.Range
With CreateObject("Scripting.FileSystemObject")
For Each Celda In Range("b4:b13")
.CopyFile ThisWorkbook.Path & "\1\" & Celda, ThisWorkbook.Path & "\proyeccion\" & Celda
Next Celda
End With
End Sub
el tema es que despues de la carpeta \1\ hay 5 subcarpetas en las que me gustaria que buscara tambien los archivos, he probado con ThisWorkbook.Path & "\1\" & "\" & Celda y no me funciona.
tambien tengo otro problema y es que si una celda y no hay nombre de archivo me devuelve un error, como puedo hacer para que se salte las celdas en blanco?
gracias de antemano.
1 Respuesta
Te anexo la macro. Primero busca el archivo en la carpeta \1
Después busca en las subcarpetas que están dentro de la carpeta \1, si encuentra el archivo, lo copia.
También puse esta validación para que salte las celdas en blanco. If Celda <> "" Then
Sub copiar_jpg()
'Mod.Por.DAM
Dim Celda As Excel.Range
ruta = ThisWorkbook.Path & "\"
With CreateObject("Scripting.FileSystemObject")
For Each Celda In Range("b4:b13")
If Celda <> "" Then
DirFile = Dir(ruta & Celda)
If DirFile <> "" Then
.CopyFile ruta & "1\" & Celda, ruta & "proyeccion\" & Celda
End If
Set carpeta = .getfolder(ruta & "1")
For Each subcarpeta In carpeta.subfolders
subsc = subcarpeta.Name
DirFile = Dir(subcarpeta & "\" & Celda)
If DirFile <> "" Then
.CopyFile subcarpeta & "\" & Celda, ruta & "proyeccion\" & Celda
End If
Next
End If
Next Celda
End With
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Perfecto muchas gracias, funciona de lujo
y para rizar el rizo, hay alguna posibilidad de que este código haga lo siguiente?
Por ejemplo que sólo copie las fotos que yo decida mediante una x en otra celda de la misma fila que la que tiene el nombre del archivo ?
Crea una nueva pregunta, puedes dirigir la pregunta a Dante Amor. En el contenido de la pregunta detalles lo que necesitas, por ejemplo en qué columna pondrías la x
