Macro para poner el valor de una celda a una carpeta

Mi nombre es Manuel, soy totalmente inexperto en la programación de macros, como mucho he llegado a grabar alguna y a copiar mas de una.

Antes de nada quiero agradecer a todos aquellos que han puesto su sabiduría en el interés general.

Tengo la siguiente macro:

Sub crearcarpeta()

CreaCarpeta "C:\Users\ ", "Archivos"

End Sub

Sub CreaCarpeta(Ruta As String, NomCarpeta As String)

'Verificar si la carpeta existe.

If Dir(Ruta, vbDirectory + vbHidden) <> "" Then

'Comprueba que la carpeta no exista para crear el directorio.

If Dir(Ruta & "\" & NomCarpeta, vbDirectory + vbHidden) = "" Then _

MkDir Ruta & "\" & NomCarpeta

End If

End Sub

Con esta macro consigo que la carpeta se llame "Archivos", pero lo que realmente estoy intentando es que en realidad se llame como la celda A!, en ella tengo la fecha del día actual.

1 Respuesta

Respuesta
1

reemplaza Archivos por Range("A1").value

Hola Víctor, encantado de conocerte, he cambiado lo que me mandaste,
evidentemente soy muy torpe, algo habr=C3=A9 hecho mal.
Te paso la línea que he cambiado y donde me sale el error:
CreaCarpeta "C:\Users\ ", Range("A1").Value
MkDir Ruta & "\" & NomCarpeta
Muchas gracias por todo
Manuel

¿En qué ruta quieres guardar el archivo?

Que valor tienes en la celda A1

El valor de la celda A1 es =HOY(), el trabajo es para una ONG, en ella se hacen entrevistas todos los días a personas necesitadas, la intención es que me abra una carpeta con la fecha del día, en ella irán metiéndose las distintas entrevistas.

Quizas el problema esté en el formato de la celda A1, no se si será compatible con el formato de la carpeta.

Si así es, tu no puedes crear una carpeta con "/", así que cambia el formato de la celda

=TEXTO(HOY();"M-D-YYYY")

Perdona, te contesté a medias, la ruta es:

C:\Users\es07813894n\Desktop\PRUEBAS

He cambiado el formato, pero me sigue saliendo el mismo error

"Se ha producido el error '76' en tiempo de ejecución:

No se ha encontrado ruta de acceso"

Cuando le doy a depurar se me remarca la siguiente línea:

MkDir Ruta & "\" & NomCarpeta

Evidentemente soy un torpe, a parte de mal discípulo y copión, al final solo era cuestión de parar y pensar lo que me decías, funciona perfectamente.

Muchas gracias por todo

Pruébalo así

Sub crearcarpeta()CreaCarpeta "C:\Users\es07813894n\Desktop\PRUEBAS\", Range("A1").ValueEnd SubSub CreaCarpeta(Ruta As String, NomCarpeta As String)'Verificar si la carpeta existe.If Dir(Ruta, vbDirectory + vbHidden) <> "" Then'Comprueba que la carpeta no exista para crear el directorio.    If Dir(Ruta & "\" & NomCarpeta, vbDirectory + vbHidden) = "" Then MkDir Ruta & "\" & NomCarpetaEnd IfEnd Sub

Y no te disculpes, para esto estamos.

Sub crearcarpeta()

CreaCarpeta "C:\Users\es07813894n\Desktop\PRUEBAS\", Range("A1").Value

End Sub

Sub CreaCarpeta(Ruta As String, NomCarpeta As String)

'Verificar si la carpeta existe.

If Dir(Ruta, vbDirectory + vbHidden) <> "" Then

'Comprueba que la carpeta no exista para crear el directorio.

If Dir(Ruta & "\" & NomCarpeta, vbDirectory + vbHidden) = "" Then MkDir Ruta & "\" & NomCarpeta

End If

End Sub

¡Gracias! 

Para terminar, una cosa nada más, he recompuesto la macro que tengo creada para ejecutar las entrevistas, hay un probemilla, la hoja que tiene que guardar me lo hace en el directorio, no en el archivo que se acaba de crear.

Paso el código de la macro:

Sub IMPRIMIR()
Range("M7").Value = Now
'
CreaCarpeta "C:\Users\es07813894n\Documents", Range("J118").Value
End Sub
Sub CreaCarpeta(Ruta As String, NomCarpeta As String)
If Dir(Ruta, vbDirectory + vbHidden) <> "" Then
If Dir(Ruta & "\" & NomCarpeta, vbDirectory + vbHidden) = "" Then _
MkDir Ruta & "\" & NomCarpeta
End If
'
ActiveWorkbook.SaveAs Filename:=Range("j114")
cadena = "C:\Users\es07813894n\Documents\" & Range("J114") & ".xlsm"
Application.ScreenUpdating = False
Sheets("ENTREVISTA").Visible = True
Sheets("DOCUMENTO PARA LUCHA").Visible = True
Sheets("ENTREVISTA").PrintOut
Sheets("DOCUMENTO PARA LUCHA").PrintOut
Sheets("DOCUMENTO PARA LUCHA").Visible = False
Dim hj
Application.ScreenUpdating = False
For Each hj In Array("DOCUMENTO PARA ECONOMICO")
With Worksheets(hj)
If .['DOCUMENTO PARA ECONOMICO'!BE40] <> "" Then
.Visible = True: .PrintOut: .Visible = False
End If
End With
Next hj
End Sub

Prueba cambiando el orden de estas líneas

ActiveWorkbook.SaveAs Filename:=Range("j114")
cadena = "C:\Users\es07813894n\Documents\" & Range("J114") & ".xlsm"

por esta

cadena = "C:\Users\es07813894n\Documents\" & Range("J114") & ".xlsm"

ActiveWorkbook.SaveAs Filename:=cadena

Me ha salido el siguiente error:

"Se ha producido el error '1004' en tiempo de ejecución.

No se puede usar esta extensión con el tipo de archivo seleccionado. Cambie la extensión del archivo en el cuadro de texto Nombre de archivo o seleccione otro tipo de archivo en el cuadro Guardar como tipo"

Me he perdido

Quitale la extesion:

cadena = "C:\Users\es07813894n\Documents\" & Range("J114")

Si con ello consigo que me lo guarde en:

"C:\Users\es07813894n\Documents"

pero no dentro de la carpeta que acaba de crear con la fecha de hoy

Ok, concatenemos el valor de la fecha

cadena = "C:\Users\es07813894n\Documents\" & Range("J118").Value & "\" & Range("J114")

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas