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