Anónimo
Crear Macro en Excel para rellenar una plantilla y separarlas en libros diferentes
Tengo una tabla excel como la siguiente:
Con algunos datos de esta tabla, tengo que rellenar esta plantilla, una plantilla por cada fila de la tabla.
Cada plantilla (una vez que rellena los datos), debe de guardarse en libros independientes que se llamaran con el nombre de la casilla "numero serie", y la hoja de cada libro debe de mantener el nombre de @PlantillaIberdola.
Notar que la tabla de datos excel, tiene muchos mas datos de los que se necesitan en la plantilla, y que en la plantilla hay campos que la tabla no tiene.
1 respuesta
Te anexo la macro para crear los archivos. Sigue las siguientes instrucciones:
1. Los nombres de los archivos no puede quedar con el nombre "007/18", no se puede guardar un archivo con una diagonal, por lo tanto, los nombres de los archivos quedarán con guión, por ejemplo: "007-18".
2. En el mismo archivo deberás tener dos hojas con el nombre: "origen" y "plantilla"
3. En la macro deberás cambiar la letra "X" por la letra de la columna que contiene el dato, por ejemplo, en la macro tengo esto:
h2.Range("B9").Value = h1.Cells(i, "X").Value 'aguaCambia la X por la letra I
H2. Range("B9").Value = h1.Cells(i, "I").Value 'agua4. Si algún campo no se tiene que llenar, entonces simplemente borra la línea en la macro, por ejemplo, si no requieres nada en el campo "Carbonos", entonces borra esta línea de la macro:
h2.Range("B15").Value = h1.Cells(i, "X").Value 'carbonos5. Ejecuta la siguiente macro:
Sub Llenar_Plantilla()
'Por Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("origen")
Set h2 = Sheets("plantilla")
'
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("B1:B5, B9:B22").ClearContents
arch = h1.Cells(i, "A").Value 'num serie
h2.Range("B1").Value = arch
h2.Range("B2").Value = h1.Cells(i, "B").Value 'fabricante
h2.Range("B3").Value = h1.Cells(i, "C").Value 'fecha muestra
h2.Range("B4").Value = h1.Cells(i, "F").Value 'punto muestra
h2.Range("B5").Value = h1.Cells(i, "E").Value 'temperatura
'
h2.Range("B9").Value = h1.Cells(i, "X").Value 'agua
h2.Range("B10").Value = h1.Cells(i, "G").Value 'color
h2.Range("B11").Value = h1.Cells(i, "J").Value 'factor disip
h2.Range("B12").Value = h1.Cells(i, "X").Value 'indice neut
h2.Range("B13").Value = h1.Cells(i, "X").Value 'tension rup
h2.Range("B14").Value = h1.Cells(i, "X").Value 'tension inter
h2.Range("B15").Value = h1.Cells(i, "X").Value 'carbonos
h2.Range("B16").Value = h1.Cells(i, "X").Value 'recuento
h2.Range("B17").Value = h1.Cells(i, "X").Value 'furfural
h2.Range("B18").Value = h1.Cells(i, "X").Value 'acetilfur
h2.Range("B19").Value = h1.Cells(i, "X").Value 'hidro
h2.Range("B20").Value = h1.Cells(i, "X").Value 'metil
h2.Range("B21").Value = h1.Cells(i, "X").Value 'furfurilalcohol
h2.Range("B22").Value = h1.Cells(i, "K").Value 'contenido inhibidor
'
'crear libro
h2.Copy
Set l2 = ActiveWorkbook
ruta = ThisWorkbook.Path & "\"
arch = Replace(arch, "/", "-") 'num serie
l2.SaveAs Filename:=ruta & arch & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
l2.Close False
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Puedes cambiar tu pregunta de anónimo a tu nombre. Finalmente tu nombre puede ser un seudónimo.