Macros: filtro avanzado con rangos dinámicos

Diego Alejo · el 27 de febrero

¡Buen dia a todos!

He generado de nuevo este tema de consulta ya que en el tema pasado no use las etiquetas para los codigos o formulas en los mensajes, y bueno espero esta vez este bien.

Entrando en el asunto lo que pasa es lo siguiente:

Los valores que se encuentran en celda “DE2” hacia abajo y hacia la derecha de la hoja: BASE, se les desea hacer un filtro avanzado con un rango dinámico (puesto que la base puede incrementar constantemente hacia abajo) para que copie los valores filtrados en la hoja: Informes de Analisis y Decision. Aunque la macro funciona, esta solo lo hace una sola vez y no lo vuelve a hacer, siendo este el error de la macro.

La macro funciona así:




Al digitar en las celdas P2:P5 de la hoja: Informes de Analisis y Decision, las palabras ANALIZADO, APLAZADO, APROBADO, EN ANALISIS, RECHAZADO y SIN DOC (Que son todas las palabras o valores de la columna ESTATUS de la hoja BASE) se realiza el filtro, pero después de realizar el filtro y copiar la información en la hoja: Informes de Analisis y Decision, después de la primera vez no lo vuelve a hacer.


Las opciones de las macros están habilitadas para su correcto funcionamiento, pues al oprimir los botones (FILTRAR, SUBTOTAL, BORRAR) de la hoja: Informes de Analisis y Decision, se observa como selecciona la celda O1 de la hoja: Informes de Analisis y Decision, que es una de las instrucciones de la macro para realizar el filtro. Las macros Filtro, Subtotales y BorrarInformes tienen la instrucción de seleccionar la celda O1 de la hoja: Informes de Analisis y Decision, con el fin de verificar que las macros se estén ejecutando y estén habilitadas.


El fin de estas macros (Filtro, Subtotales y BorrarInformes) es que se pueda repetir el proceso cuantas veces sea necesario, digitando en las celdas P2:P5 de la hoja: Informes de Analisis y Decision, las opciones ANALIZADO, APLAZADO, APROBADO, EN ANALISIS, RECHAZADO y SIN DOC.


[/CODE]

[CODE]

Sub Filtro()
' Filtro Macro
' Filtra las solicitudes por Asistencia y Estatus, para luego generar las Macros de los informes.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Sheets("BASE").Range("Rangobaseinformes1").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Informes de Analisis y Decision").Range("O15"), CopyToRange:=Sheets("Informes de Analisis y Decision").Range("A6"), Unique:=False
Range("O1").Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.CutCopyMode = False

End Sub

Sub Subtotales()
' Subtotales Macro
' Realiza una cuenta de las solicitudes por Estamento Teorico y tambien da formato a las celdas para su impresion.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Range("A6").Select
Selection.Subtotal GroupBy:=11, Function:=xlCount, TotalList:=Array(11), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A1:K2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("A3:K5").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("A6:K6").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:K2").Select
ActiveCell.FormulaR1C1 = " ANEXO "
Range("A1:K2").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("C3").Select
ActiveCell.FormulaR1C1 = " INFORME "
Range("C3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.Bold = True
Range("O1").Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.CutCopyMode = False

End Sub

Sub BorrarInformes()

' BorrarInformes Macro
' Borra Informes de Analisis y Decision, para poder volver a realizar informes.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Range("A1:K5").Select
Selection.ClearContents
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
Range("A6").Select
Selection.RemoveSubtotal
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

Selection.ClearContents
Range("P2:P5").Select
Selection.ClearContents
Range("O1").Select

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.CutCopyMode = False

End Sub

[/CODE]

V3.zip