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

Respuesta
3

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 Sub

Estas llamadas van en el evento Close del Userform.

Respuesta
1

Revisa los consejos para sintetizar código y mejorar el rendimiento de las macros:

https://youtu.be/HfFCtMl189U 

Sal u dos

Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas