Macro para guardar archivo excel, con nombre de una celda, en una carpeta creada por la misma macro
Los expertos,
Me gustaría que me ayudaran si fuera posible, requiero desarrollar una macro en excel que me permita crear una carpeta, con el nombre de una celda del libro excel, dónde a continuación genere una copia pero de los datos de otra celda, dicho archivo renombrado con el contenido de otra celda.
Ejemplo:el archivo contiene Países y capitales requiero crear por cada país una carpeta, y que genere un archivo de excel por cada capital
2 Respuestas
Luis Alfredo.
No se si mi respuesta te sirve pero puede orientarte un poco. Te adjunto una macro con la que podrás guardar el archivo Excel con el nombre de una celda especifica.
ActiveWorkbook.SaveAs Filename:=Range("B83")
Donde "B83" se sustituye por la celda que tu quieras para que el Excel se guarde con este nombre.
Si creas manualmente las carpetas añadiendo la ruta te podría servir emplear el siguiente código:
ChDir _
"C:\España\Madrid"
ActiveWorkbook.SaveAs Filename:=Range("B83")
Esta macro te guardaría el valor de la celda B83 como nombre del archivo Excel en la carpeta de la ruta indicada.
Lamento no poder darte mejor solución pero quizás con esto puedas avanzar mientras no te llegue una respuesta mejor.
Suponiendo que tienes en la columna A los países y en la columna B las capitales.
Pon la macro en el archivo que tiene tus datos. Guarda el archivo en la carpeta en donde quieres que se creen las nuevas carpetas.
Según el ejemplo, con la macro se crearán las carpetas España, Francia e Italia.
Comentas: "y que genere un archivo de excel por cada capital"; pero no mencionaste qué debe contener el achivo que se genere, por lo que la macro creará una copia del mismo archivo con el nombre Madrid, París y Roma y guardará cada archivo en la carpeta de su país respectivo.
Te anexo la macro:
Sub carpetas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
l1.Save
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Dir(l1.Path & "\" & Cells(i, "A"), vbDirectory) = "" Then
MkDir l1.Path & "\" & Cells(i, "A")
End If
Worksheets.Copy
ActiveWorkbook.SaveAs l1.Path & "\" & Cells(i, "A") & "\" & Cells(i, "B")
ActiveWorkbook.Close
Next
MsgBox "Copias terminadas", vbInformation
End Sub