Macro para filtrar en varias hojas

Para dante

Fíjate que necesito macro para filtrar, tengo un libro de excel con cinco hojas, y necesito que en el userform se selecciones la hoja a filtrar y luego hacer el filtro entre fechas (desde hasta).

La macro esta hecha pero no se como hacer que luego de seleccionar la hoja mediante optionbutton me llame el código para hacer el filtro.

1 Respuesta

Respuesta
1

H o l a:

No es necesario que selecciones la hoja, solamente tienes que hacer referencia a la hoja que vas a utilizar, por ejemplo, con esta instrucción le estoy indicando cuál hoja es la que voy a utilizar:

With Sheets("Clientes" & n)

La n es una variable y contienen el número de hoja, el número de hoja se pasa como parámetro cuando seleccionas el optionbutton, de esta forma, tampoco es necesario un botón para llamar el filtrado, solamente tienes que hacer click en cualquiera de los optionbutton y el filtro se realizará.

Private Sub OptionButton1_Click()
    Call filtrarfe(1)
End Sub
Private Sub OptionButton2_Click()
    Call filtrarfe(2)
End Sub
Private Sub OptionButton3_Click()
    Call filtrarfe(3)
End Sub
Private Sub OptionButton4_Click()
    Call filtrarfe(4)
End Sub
Private Sub OptionButton5_Click()
    Call filtrarfe(5)
End Sub

La macro competa:

Private Sub filtrarfe(n)
'Act.Por.Dante Amor
    Dim fec1 As Date, fec2 As Date
    Application.ScreenUpdating = False
    If TextBox1 = "" Or TextBox2 = "" Then MsgBox "Captura las fechas": Exit Sub
    '
    Set hm = Sheets("filtros")
    hm.Cells.Clear
    fec1 = TextBox1
    fec2 = TextBox2
    With Sheets("Clientes" & n)
        .Rows(1).Copy hm.Rows(1)
        For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If .Cells(i, "B") >= fec1 And .Cells(i, "B") <= fec2 Then
                u = hm.Range("A" & Rows.Count).End(xlUp).Row + 1
                .Rows(i).Copy
                hm.Rows(u).PasteSpecial Paste:=xlPasteValues
                hm.Rows(u).PasteSpecial Paste:=xlPasteFormats
                hm.Cells(u, "B").Interior.ColorIndex = 4
            End If
        Next
    End With
    '
    hm.UsedRange.Borders.LineStyle = xlContinuous
    u = hm.Range("A" & Rows.Count).End(xlUp).Row
    With hm.Sort
        .SortFields.Clear
        .SortFields.Add Key:=hm.Range("A1:A" & u), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange hm.Range("A1:I" & u)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   'Unload Me
    hm.Select
    Range("A2").Select
    Application.ScreenUpdating = True
End Sub
'
Private Sub OptionButton1_Click()
    Call filtrarfe(1)
End Sub
Private Sub OptionButton2_Click()
    Call filtrarfe(2)
End Sub
Private Sub OptionButton3_Click()
    Call filtrarfe(3)
End Sub
Private Sub OptionButton4_Click()
    Call filtrarfe(4)
End Sub
Private Sub OptionButton5_Click()
    Call filtrarfe(5)
End Sub
Private Sub CommandButton2_Click()
    TextBox1 = ""
    TextBox2 = ""
    TextBox1.SetFocus
End Sub
'
Private Sub textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
    Select Case Len(TextBox1.Value)
    Case 2
    TextBox1.Value = TextBox1.Value & "/"
    Case 5
    TextBox1.Value = TextBox1.Value & "/"
    End Select
End Sub
'
Private Sub textbox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
    Select Case Len(TextBox2.Value)
    Case 2
    TextBox2.Value = TextBox2.Value & "/"
    Case 5
    TextBox2.Value = TextBox2.Value & "/"
    End Select
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas