Crear formularios a partir de una base de datos automáticamente
Mensualmente recibiré una planilla con unas 500 filas de datos de donde deberé crear un formulario por fila.
El formulario lo tengo creado y necesito que por fila me ponga por ejemplo, el nombre, la dirección, el valor, entre otras.
La base de datos siempre tendrá una cantidad de datos distinta por lo que no siempre serán exactamente los mismos.
Me gustaría que la macro que me ayude a crear barra todos los datos y cree una copia del formulario con un nombre distinto que estará en la misma ubicación
Antes de crear el formulario la macro debe reviaar si es pertinente, es decir, revisar el valor de la columna A desde A2 hasta el ultimo dato y si esta dice "sin deuda" crea el formulario de esa fila, si dice "con deuda" revisa la siguiente fila y omite esos datos, luego debe tomar el dato de la columna B desde B2 hasta el ultimo dato y ponerlo en el otro archivo en la celda D5, luego el dato de C2 en la celda D7 y así sucesivamente hasta la columna N. Yo podre modificar las celdas, nombres de archivo y hojas para no quitarle tiempo extra.
Espero haberle entregado toda la infomlrmacion y me pueda ayudar.
1 Respuesta
Pon la macro en el archivo que tiene el formulario.
No comentaste cómo se llama la hoja que contiene el formulario, así que le puse "formulario"
Tampoco comentaste cómo se llama la hoja que tiene las 500 filas con datos, así que la macro va a tomar la hoja 1.
Te agregué una opción para que con la macro selecciones el archivo con las 500 filas.
Después de que seleccionas el archivo, la macro lo procesa.
Tampoco pusiste qué nombre ponerle a cada archivo que se genere, la macro le va a poner "formato1", "formato2", etc.
En la macro solamente puse 2 celdas la D5 y la D7, son las únicas que pusiste en tu ejemplo.
Sub GenerarFormularios()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("formulario")
ruta = l1.Path & "\"
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Selecciona el archivo"
.Filters.Clear
.Filters.Add "archivos Excel", "*.xls*"
.Filters.Add "Todos", "*.*"
.FilterIndex = 1
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show Then
Set l2 = Workbooks.Open(.SelectedItems.Item(1))
Set h2 = l2.Sheets(1)
n = 1
'
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If UCase(h2.Cells(i, "A")) = "SIN DEUDA" Then
h1.Copy
Set l3 = ActiveWorkbook
Set h3 = l3.ActiveSheet
h3.[D5] = h2.Cells(i, "B")
h3.[D7] = h2.Cells(i, "C")
'
nombre = "formulario " & n & ".xlsx"
l3.SaveAs ruta & nombre
l3.Close
n = n + 1
End If
Next
l2.Close False
End If
End With
MsgBox "Terminado"
End SubSaludos. Dante Amor
Recuerda valorar la respuesta.
