Filtro avanzado
¿Me podrías ayudar con filtros avanzados por medio de macro? Tengo la sig. Rutina pero no me respeta el valor del filto que le pongo. Gracias de antemano
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call filtrar
End If
If Target.Address = "$B$2" Then
Call Filtrar2
End If
End Sub
Private Sub filtrar()
Application.ScreenUpdating = False
uf = Sheets("BD").[A65536].End(xlUp).Row
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A2:b2"), CopyToRange:=Range("A7:F7"), Unique:=False
Application.ScreenUpdating = True
End Sub
Private Sub Filtrar2()
Application.ScreenUpdating = False
uf = Sheets("BD").[A65536].End(xlUp).Row
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("a2:b2"), CopyToRange:=Range("A7:F7"), Unique:=False
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$2" Then
Call filtrar
End If
If Target.Address = "$B$2" Then
Call Filtrar2
End If
End Sub
Private Sub filtrar()
Application.ScreenUpdating = False
uf = Sheets("BD").[A65536].End(xlUp).Row
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A2:b2"), CopyToRange:=Range("A7:F7"), Unique:=False
Application.ScreenUpdating = True
End Sub
Private Sub Filtrar2()
Application.ScreenUpdating = False
uf = Sheets("BD").[A65536].End(xlUp).Row
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("a2:b2"), CopyToRange:=Range("A7:F7"), Unique:=False
Application.ScreenUpdating = True
End Sub
1 Respuesta
Respuesta de Elsa Matilde
1
Para utilizar filtros avanzados necesitas tener los mismos títulos en ambas hojas, es decir si la hoja BD tiene en fila1 los títulos, tu hoja debe tener en fila1 los títulos y en fila 2 los datos del criterio.
Entonces tu instrucción sería:
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ActiveSheet.Range("A1:B2"), CopyToRange:=Range("A7:F7"), Unique:=False
Como ahora se te repetirán los títulos en fila 7 podés eliminarla con esta instrucción:
Rows("7:7").Select
Selection.Delete Shift:=xlUp
Entonces tu instrucción sería:
Sheets("BD").Range("A1:F" & uf).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ActiveSheet.Range("A1:B2"), CopyToRange:=Range("A7:F7"), Unique:=False
Como ahora se te repetirán los títulos en fila 7 podés eliminarla con esta instrucción:
Rows("7:7").Select
Selection.Delete Shift:=xlUp
