Macro para ocultar celdas vacías

Para dante

Podrías ayudarme

Necesito una macro para ocultar celdas vacías y solo mostrar aquellas que contienen datos en la columna C. Y que pueda usar la macro en cada hoja ( son 5 hojas: Medicamentos, Planificación F., Quirúrgico, M. De Oficina, M. De Limpieza) y que la macro funcione cuando selecciono una de esas hojas con los optionbutton que aparecen arriba del formulario.

1

1 Respuesta

3.691.950 pts. Si me amas, siempre voy a estar en tu corazón; si me...

H o l a:

Te anexo el código para ocultar:

 'ocultar celdas vacias (filtro) y solo mostrar aquellas que contienen datos en la columna C
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="<>"

La macro completa:

Private Sub filtrard_click()
    Dim fec1 As Date, fec2 As Date
    'Application.ScreenUpdating = False
    'controlar que haya algún OB seleccionado
    If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False Then
        MsgBox "Debes seleccionar algún botón de Cliente. Luego ejecuta nuevamente el botón de guardado.", , "ERROR"
        Exit Sub
    End If
    '------------
    '
    'ocultar celdas vacias (filtro) y solo mostrar aquellas que contienen datos en la columna C
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="<>"
    '
    Set hm = Sheets("filtros")
    'borra filas de filtros anteriores manteniendo los titulos
    'hm.Rows("2:" & hm.Range("A" & Rows.Count).End(xlUp).Row).Delete
    hm.Cells.Clear
    fec1 = TextBox1
    fec2 = TextBox2
    Hoja = ActiveSheet.Name  'no haria falta xq estas en la hoja elegida
    j = 4   'siempre sera la col 2
    For i = 2 To Sheets(Hoja).Range("A" & Rows.Count).End(xlUp).Row
        If Sheets(Hoja).Cells(i, j) >= fec1 And Sheets(Hoja).Cells(i, j) <= fec2 Then
            u = hm.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets(Hoja).Rows(i).Copy
            'pegar solo valores y  formatos
            hm.Rows(u).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            hm.Rows(u).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            hm.Cells(u, j).Interior.ColorIndex = 4
        End If
    Next
    '
    'With hm.Cells
    '    .Borders(xlEdgeLeft).LineStyle = xlNone
    '    .Borders(xlEdgeTop).LineStyle = xlNone
    '    .Borders(xlEdgeBottom).LineStyle = xlNone
    '    .Borders(xlEdgeRight).LineStyle = xlNone
    '    .Borders(xlInsideVertical).LineStyle = xlNone
    '    .Borders(xlInsideHorizontal).LineStyle = xlNone
    'End With
    With hm.UsedRange
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        Range("a2").Select
    Application.ScreenUpdating = True
    End With
    '
    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
   Call copiar
   'Unload Me  'filtrar     'UserForm1
   Sheets("filtros").Select
   'Call Columna
   Columns("J").EntireColumn.Hidden = True
   Columns("K").EntireColumn.Hidden = True
   Columns("L").EntireColumn.Hidden = True
   Columns("M").EntireColumn.Hidden = True
   Columns("N").EntireColumn.Hidden = True
   Range("A2").Select
   TextBox1 = ""
   TextBox2 = ""
   OptionButton1.Value = False
   OptionButton2.Value = False
   OptionButton3.Value = False
   OptionButton4.Value = False
   OptionButton5.Value = False
End Sub

Para mostrar:

    On Error Resume Next
    For Each h In Sheets
        h.ShowAllData
    Next
    On Error GoTo 0

La macro completa:

Private Sub CommandButton3_Click()
    TextBox1 = ""
    TextBox2 = ""
    Range("A2").Select
    On Error Resume Next
    For Each h In Sheets
        h.ShowAllData
    Next
    On Error GoTo 0
    OptionButton1.Value = False
    OptionButton2.Value = False
    OptionButton3.Value = False
    OptionButton4.Value = False
    OptionButton5.Value = False
    Filtrar2.Hide
    ThisWorkbook.Application.Visible = False
    Set hm = Sheets("filtros")
    hm.Cells.Clear
    Load Menu
    Menu.Show
End Sub

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas