Macro para colocar bordes a filas

Quiero colocar bordes solo a las filas que tienen datos de un filtro, los bordes si se colocan pero se pasan de las filas que tienen registros.

La cantidad de filas con registros puede viarar, y quiero que solo esas tengan bordes y no como se ve en la imagen. El encabezado esta en la fila 2 y los registros van desde la fila 3.

Este es el código para filtrar y pegar el resultado

La fila marcada en negrita es la que da los bordes

Espero su ayuda

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

'------------

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 = 3 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 + 2

            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

          hm.UsedRange.Borders.LineStyle = xlContinuous

        End If

        Next

    '     

    u = hm.Range("A" & Rows.Count).End(xlUp).Row

    With hm.Sort

        .SortFields.Clear

        .SortFields.Add Key:=hm.Range("A3:A" & u), _

            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        .SetRange hm.Range("A3:I" & u)

        .Header = xlYes

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

   Call copiar

   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

1 respuesta

Respuesta
2

H o l a:

Quita esta línea de tu macro

hm.UsedRange.Borders.LineStyle = xlContinuous

Pon las siguiente líneas después del Next

u = hm.Range("A" & Rows.Count).End(xlUp).Row
hm.Range("A1:I" & u).Borders.LineStyle = xlContinuous
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas