Como mejorar Macro que actualiza Datos en 2 hojas del mismo Libro
Mediante la grabadora de Macro pude desarrollar la Macro Agregar_HojaAuxiliar(), pero veo a mi criterio por lo visto en dicho foro otras Macros que no son tan extensas por que sintetizan algunas líneas, habrá alguna posibilidad que en esta se pueda realizar algo.
El objetivo es que en la hoja "DATOS" si se realiza alguna modificación la misma se debe reflejar en las otras hojas ("BASE", "AUXILIAR") respetando los campos asignados en cada columna. (La hoja "AUXILIAR" solamente tiene 3 columnas "COD, APELLLIDO, NOMBRE"
Les dejo la Macro
Sub Agregar_HojaAuxiliar()
'
' Agregar_HojaAuxilio Macro
' Se actualiza la Hoja Auxilio
'
Worksheets("Base").Visible = True
Worksheets("Auxiliar").Visible = True
Application.ScreenUpdating = False
Sheets("DATOS").Select
Range("A8").Select
ActiveWorkbook.Worksheets("DATOS").ListObjects("TDatos").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DATOS").ListObjects("TDatos").Sort.SortFields.Add _
Key:=Range("TDatos[[#All],[P]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATOS").ListObjects("TDatos").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A8").Select
Sheets("BASE").Select
Range("F11").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("F11").Select
Sheets("DATOS").Select
Range("A8").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("BASE").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F11").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Sheets("Auxiliar").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A2").Select
Sheets("DATOS").Select
Range("A8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Auxiliar").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B2").Select
Sheets("DATOS").Select
Range("C8:D8").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Auxiliar").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Sheets("DATOS").Select
Range("A8").Select
Application.CutCopyMode = False
Worksheets("Base").Visible = False
Worksheets("Auxiliar").Visible = False
End Sub
2 respuestas
Por la manera en que reordenas tu hoja Datos luego de cada registro, y considerando que tu lista de alumnos es muy pequeña, lo mejor será que recién al finalizar la tarea en el formulario (o sea luego de crear/modificar/eliminar datos) hagas la copia a las otras 2 hojas.
Te dejo las 2 subrutinas separadas porque vi que haces un Call por cada hoja.
Sub actualiza_Auxiliar()
'se visibiliza la hoja y se limpia el rango
With Sheets("Auxiliar")
.Visible = True
rgo = .Range("A1").CurrentRegion.Offset(1, 0).Address
.Range(rgo).ClearContents
End With
'copia desde DATOS solo 3 col: P, Apellido y Nombre
With Sheets("DATOS")
.Range("TDatos[P]").Copy
Sheets("Auxiliar").Select
[A2].Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("TDatos[[Apellido]:[Nombre]]").Copy
[B2].Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
[A1].Select
'se oculta la hoja auxiliar
Worksheets("Auxiliar").Visible = False
End With
End Sub
Sub actualiza_BASE()
'se visibiliza la hoja y se limpia la tabla de datos
With Sheets("BASE")
.Visible = True
.Select
ActiveSheet.ListObjects(1).DataBodyRange.Select
Selection.Clear
End With
'copia el rango de la hoja DATOS
With Sheets("DATOS")
.Range("TDatos").Copy
Sheets("BASE").Select
[F11].Select
'mantiene el formato de la tabla destino
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'opcional: seleccionar alguna celda de la tabla
[F11].Select
'se oculta la hoja BASE
ActiveSheet.Visible = False
End With
End SubEstas llamadas van en el evento Close del Userform.
Revisa los consejos para sintetizar código y mejorar el rendimiento de las macros:
Sal u dos
Dante Amor