Macro para crear carpeta con nombre de celdas
Estimado muy buenas tardes! Tengo un problema con una macro que no logro resolver... Cree un botón el cual al oprimirlo guarda una hoja de excel en PDF con el nombre de dos celdas (valor de celda1+valor de celda2). Ahora bien quiero hacer lo mismo pero que me guarde la hoja en formato XLS (habilit. ¿p/macro) y que lo guarde dentro de una carpeta que se debería crear al oprimir tal botón y con el nombre de las mismas celdas 1 y 2... Me podría dar una mano con esto?... Ya le adjunto la macro para que pueda verla.
2 Respuestas
Hola Dante, gracias por tu pronta respuesta...soy nuevo en este foro y estoy aprendiendo a usarlo. te paso la macro
---------------------------------------------------------------------------------------------------------------------------------
Sub Botón11_Haga_clic_en()
Dim rutaarchivo As String
rutaarchivo = "C:\Users\Nahuel\Documents\Nahuel\VIC Montajes Eléctricos\GESTION COMERCIAL\GCVIC2.5\computo de obra\" & [C6] & [V2]
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutaarchivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveSheet.Unprotect "ICPT239941"
Range("V2:W2").Copy
Sheets("Registro computo de obras").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Range("a1").Copy
Range("v3").Copy
Sheets("Registro computo de obras").Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Range("b1").Copy
Range("C7").Copy
Sheets("Registro computo de obras").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Range("c2").Copy
Range("C10").Copy
Sheets("Registro computo de obras").Range("D65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Range("D1").Copy
Range("A69:F75").Copy
Sheets("Registro computo de obras").Range("E65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Range("E1").Copy
[V2] = [V2] + 1
ActiveSheet.Protect "ICPT239941"
End Sub
Dante, pongo el código para probar y me salta error:
Sub Botón1_Haga_clic_en()
ruta = ThisWorkbook.Path & "C:\Users\Nahuel\Desktop"
MkDir ruta & Range("A1") & Range("A2")
End Sub
Estas agregando dos rutas, Utiliza esto:
ruta = "C:\Users\Nahuel\Desktop\"
MkDir ruta & Range("A1") & Range("A2")Revisa que esté bien escrito el directorio
"C:\Users\Nahuel\Desktop\"
Saludos. Dante Amor
Recuerda valorar la respuesta.
Revisé y esta bien escrito el directorio...viste la macro que te envié ...tal vez se podría adaptar..????
Pero primero haz la prueba de crear una carpeta.
Utiliza esto para hacer la prueba, solamente haz una prueba para crear una carpeta, pon la siguiente macro en un módulo y ejecuta la macro, te debe crear una carpeta que se llama "Nuevo"
Sub NuevaCarpeta() ruta = ThisWorkbook.Path & "\" MkDir ruta & "Nuevo" End Sub
Después de que hayas hecho la prueba, dime que tienes en la celda1 y en la celda2
Hola Dante, hago el intento y sigue enviando error... ¿en las comillas quedo así "c:\" esta bien así?... pido disculpas pero estoy aprendiendo... Gracias!
se puede enviar archivos por el foro?...
El error dice así: error de compilación" no se ha definido variable... y el código quedo de esta manera...
Sub Botón1_Haga_clic_en()
ruta = ThisWorkbook.Path & "C:\"
MkDir ruta & "Nuevo"
End Sub
Solamente prueba mi macro tal cual te la puse:
Sub NuevaCarpeta() ruta = ThisWorkbook.Path & "\" MkDir ruta & "Nuevo"End Sub
Estimado me sigue dando error aún poniéndolo así... adjunto una imagen por ahí hago algo mal...
La carpeta "nuevo" ya existe por eso te envía ese error.
Cambia "nuevo" por "nuevo2", o revisa tus carpetas y borra la carpeta "nuevo" y vuelve a ejecutar la macro para que ves cómo funciona.
Prueba con esta macro:
Sub NuevaCarpeta() 'Por.Dante Amor ruta = ThisWorkbook.Path & "\" arch = "nuevo2" If Dir(ruta & arch, vbDirectory) = "" Then MkDir ruta & arch Else MsgBox "La carpeta ya existe", vbCritical End If End Sub
Con esta última macro no hay pierde, si existe te envía erro, si no existe la crea.
Ahora solamente cambia arch = "nuevo2" por las celdas, quedarìa así:
Sub NuevaCarpeta() 'Por.Dante Amor ruta = ThisWorkbook.Path & "\" arch = [C6] & [V2] If Dir(ruta & arch, vbDirectory) = "" Then MkDir ruta & arch Else MsgBox "La carpeta ya existe", vbCritical End If End Sub
Saludos.Dante Amor
