.
El ejemplo se realizó por pedido de un suscriptor de nuestro canal de youtube, la macro muestra como crear un archivo o fichero de Excel por cada registro de un listado, es decir que partiendo de un hoja de Excel con un listado de nombres la macro a recorriendo cada fila y creando un archivo de Excel con cada registro, siendo el nombre del archivo el correspondiente al registro de cada fila.
Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.
if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}
En un primer momento verifica si existe la carpeta donde se guardarán los archivos, en caso de no existir la crea, la carpeta se va a ubicar en el directorio donde se encuentre el archivo con la macro adicionando o creando la carpeta en ese mismo directorio llamada «Archivos Excel», el siguiente código realiza lo mencionado:
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también
Como determinar el nombre de un archivo
Como buscar palabra en un archivo de Word en un Directorio si lo encuentra crea link
Como buscar un archivo en una carpeta y determinar su ruta o path
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Luego se crea un bucle For… Next, en el ejemplo va del 5 al 20, la fila con datos empieza en la fila 5 por eso comienza en 5 y 20 es un número que se puso a los fines del ejemplo, cada uno lo puede modificar incluso el bucle puede ir hasta la última fila con datos, pero se debe tener en cuenta que dependiendo de la cantidad de registros la macro tardará unos minutos en crear todos los archivos de Excel.
En cada recorrido de bucle, se determinará el nombre del archivo que va a crear, el nombre del fichero lo toma de la columna B y fila correspondiente, al nombre se le quitan los posibles caracteres que pueda contener el nombre del archivo y que son inválidos para nombrar archivos, porque son caracteres exclusivos de Windows, se hace con el siguiente código:
Por último crear el archivo, lo guarda con el nombre determinado y cierra el fichero, para seguir con la creación del siguiente archivo de Excel hasta que se cumpla el bucle, el siguiente es el código usado, al final está el código completo.
Código que se inserta en un módulo
Sub CreaArchivoExcel()
Dim verexi As Object, rutaxls As String, rutadir As String, nomfic As String, conta As Variant
Dim ObjExcel As Application, ObjLibro As Workbook
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Sheets(«BD URL»)
If a.Range(«B5») = Empty Then
MsgBox «No existen registros para crear archivos Excel», vbCritical, «AVISO»
Exit Sub
End If
conta = 0rutadir = ActiveWorkbook.Path & «Archivos Excel»
If Dir(rutadir, vbDirectory) = «» Then
MkDir rutadir
End If
‘uf = a.Range(«B» & Cells.Rows.Count).End(xlUp).Row
uf = 20
For x = 5 To uf
Application.StatusBar = «Creando » & x & » de » & uf & » archivos Excel»
nomfic = a.Cells(x, 2)
nomfic = Replace(nomfic, «/», «»)
nomfic = Replace(nomfic, «,», «»)
nomfic = Replace(nomfic, «…», «»)
nomfic = Replace(nomfic, «.», «»)
nomfic = nomfic & «.xlsx»
rutaxls = rutadir & «» & nomfic
conta = conta + 1
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=rutaxls
Workbooks(nomfic).Close SaveChanges:=True
Next x
MsgBox «Se crearon » & conta & » archivos de Excel», vbCritical, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Dim verexi As Object, rutaxls As String, rutadir As String, nomfic As String, conta As Variant
Dim ObjExcel As Application, ObjLibro As Workbook
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Sheets(«BD URL»)
If a.Range(«B5») = Empty Then
MsgBox «No existen registros para crear archivos Excel», vbCritical, «AVISO»
Exit Sub
End If
conta = 0
rutadir = ActiveWorkbook.Path & «Archivos Excel»
If Dir(rutadir, vbDirectory) = «» Then
MkDir rutadir
End If
‘uf = a.Range(«B» & Cells.Rows.Count).End(xlUp).Row
uf = 20
For x = 5 To uf
Application.StatusBar = «Creando » & x & » de » & uf & » archivos Excel»
nomfic = a.Cells(x, 2)
nomfic = Replace(nomfic, «/», «»)
nomfic = Replace(nomfic, «,», «»)
nomfic = Replace(nomfic, «…», «»)
nomfic = Replace(nomfic, «.», «»)
nomfic = nomfic & «.xlsx»
rutaxls = rutadir & «» & nomfic
conta = conta + 1
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=rutaxls
Workbooks(nomfic).Close SaveChanges:=True
Next x
MsgBox «Se crearon » & conta & » archivos de Excel», vbCritical, «AVISO»
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
.
If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.
Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends