¡Hola!

Estoy trabajando con un macro que copie toda una carpeta con subcarpetas y archivos a otra ubicación, el nombre de las carpetas estan en A1, la ruta donde las voy a mover en B1.

Por ahora tengo esto pero no logro que funcione.

 

Sub copiafolder()
Dim FSO As Object
    Dim inicio As String
    Dim fin As String
    Dim valida As String

    Set FSO = CreateObject("scripting.filesystemobject")


Range("A1").Select
On Error Resume Next
Do While ActiveCell.Value <> ""
    inicio = Range("B1") & ActiveCell
    fin = Range("B1")
    valida = Dir(inicio)
    If valida = "" Then
        Else
        FSO.CopyFolder inicio, fin
        End If
    ActiveCell.Offset(1, 0).Select
Loop

End Sub

 

Como dato adicional, por ahora las carpetas están en mi escritorio, pero pienso cambiarla por una formula que completa la ruta donde se encuentran.

Por ejemplo:
En A1 estaria "X:\documentos\car1"
En B1 esaria la ruta donde deben pegarse las carpetas "D:\contenedor"

carpetas.xlsm

Hola

En el supuesto que tu celda A1 contenga "X:\documentos\car1" y B1 contenga "D:\contenedor"", tu variable inicio quedaría así:

"D:\contenedorX:\documentos\car1"

Si queda como en tu archivo, en A1 solo diga "car1", y en B1 "C:\Users\Microformas\Desktop\destino",  tu variable inicio quedaría como:

"C:\Users\Microformas\Desktop\destinocar1"

¿Notas el error en ambos casos? 

Abraham Valencia

 

Ahora mismo, avalencia dijo:

Hola

En el supuesto que tu celda A1 contenga "X:\documentos\car1" y B1 contenga ""X:\documentos\car1"", tu variable inicio quedaría así:

"X:\documentos\car1X:\documentos\car1"

Si queda como en tu archivo, en A1 solo diga "car1", y en B1 "C:\Users\Microformas\Desktop\destino",  tu variable inicio quedaría como:

"C:\Users\Microformas\Desktop\destinocar1"

¿Notas el error en ambos casos? 

Abraham Valencia

 

¡SI!, el ultimo de tus ejemplos es como lo estoy trabajando ahora, pero se me hace raro que en el caso donde en A1 tengo "car1" y en B1  "C:\Users\Microformas\Desktop\destino"

Corrijo con esto ¿no?

inicio = Range("B1") & "\" & ActiveCell

Pero aun así no funciona.

 

Y en el primer ejemplo es como me gustaria trabajar el macro, pero seria solo ajustarlo. Por ahora no logro que copie nada.

Solo una correccion en tu codigo te digo por que a mi me dio Muelas llegar a esto espero te ayude

Origen =  "c:\DirectorioOrigen\*.*"  ' yo no se por que a mi me pedia que especifique el  *.*

destino =  "c:\DirectorioDestino\"  ' y en el destino tenga al final la barra invertida o antislash "\" 

fso.CopyFolder origen ,destino ,1 ' el uno para que sobreescriba 

 

Espero te ayude

Do While ActiveCell.Value <> ""
    inicio = Range("B1") & ActiveCell
    fin = Range("B1")
    valida = Dir(inicio)
     msgbox inicio  &  " - " & fin  ' estas seguro que existe esa ruta ??? presentala para ver si te vale
    If valida = "" Then  
        Else
        FSO.CopyFolder inicio, fin
        End If
    ActiveCell.Offset(1, 0).Select
Loop

Ahora mismo, silver_axe007 dijo:

Solo una correccion en tu codigo te digo por que a mi me dio Muelas llegar a esto espero te ayude

Origen =  "c:\DirectorioOrigen\*.*"  ' yo no se por que a mi me pedia que especifique el  *.*

destino =  "c:\DirectorioDestino\"  ' y en el destino tenga al final la barra invertida o antislash "\" 

fso.CopyFolder origen ,destino ,1 ' el uno para que sobreescriba 

 

Espero te ayude

Sub copiafolder()
Dim FSO As Object
    Dim inicio As String
    Dim fin As String
    Dim valida As String

    Set FSO = CreateObject("scripting.filesystemobject")


Range("A1").Select
On Error Resume Next
Do While ActiveCell.Value <> ""
    inicio = Range("B1") & "\" & ActiveCell & "\" & "*.*"
    fin = Range("B1")
    MsgBox inicio & " - " & fin    ' estas seguro que existe esa ruta ??? presentala para ver si te vale
    valida = Dir(inicio)
    If valida = "" Then
        Else
        FSO.CopyFolder inicio, fin, 1
        End If
    ActiveCell.Offset(1, 0).Select
Loop


End Sub

agrege el *.*¨y el slash, la ruta parece estar bien pero no copia nada.

 

 

 

 

no se si tenga que ver que quueres copiar de una subcarpeta a una carpeta 

puede ser por eso .. digo yo .--- cambia a direcciones como c:\origen y c:\destino .. prueba asi