Te anexo el código
Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Cerrar formulario
Private Sub cbtCera_Click()
Application.ScreenUpdating = False
Set h2 = Sheets("filtro")
h2.Unprotect Password:="By Jot@"
h2.Cells.Clear 'Contents
Unload Me
h2.Protect Password:="By Jot@"
Application.ScreenUpdating = True
End Sub
'Elimina y vuelve a filtrar para actualisar tabla.
Private Sub cbtElimi_Click()
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6tq7iumqenw3rrpx/eliminar-los-registros-seleccionados-en-el-listbox
'Eliminar el registro
ActiveSheet.Unprotect Password:="By Jot@"
If Lista2.ListIndex = -1 Then
MsgBox "No hay registros"
Exit Sub
End If
seleccionado = False
For i = 0 To Lista2.ListCount - 1
If Lista2.Selected(i) Then
seleccionado = True
Exit For
End If
Next
If seleccionado = False Then
MsgBox "Selecciona un registro"
Exit Sub
End If
Pregunta = MsgBox("Está seguro para eliminar el registro?", vbYesNo + vbQuestion, "Eliminación")
If Pregunta = vbNo Then Exit Sub
'Selecciona la pagina
If OptionButton1 Then
c1 = "B": c2 = "K": c3 = "C": c4 = "D"
ElseIf OptionButton2 Then
c1 = "M": c2 = "V": c3 = "N": c4 = "O"
End If
'Elimina lo seleccionado
Application.ScreenUpdating = False
For i = Lista2.ListCount - 1 To 0 Step -1
If Lista2.Selected(i) Then
fila = Lista2.List(i, 10)
If fila < 46 Then
Range(c1 & fila + 1 & ":" & c2 & 46).Copy Range(c1 & fila)
End If
Range(c1 & 46 & ":" & c2 & 46).ClearContents
'Mover registro de página 2
If Range("M11") <> "" Then
Range("B46") = Range("M11")
Range("C46") = Range("N11")
Range("D46") = Range("O11")
Range("J46") = Range("U11")
Range("K46") = Range("V11")
Range("M12:V46").Copy Range("M11")
End If
End If
Next
Call FiltrarLista2(c1, c2, c3, c4, True)
'Combina las celdas D:I y O:T y da formato centrado
Application.ScreenUpdating = False
For i = 11 To 46
Range("D" & i & ":I" & i).Merge
Range("D" & i & ":I" & i).HorizontalAlignment = xlCenter
Range("O" & i & ":T" & i).Merge
Range("O" & i & ":T" & i).VerticalAlignment = xlCenter
Next
Range("B11:B46").NumberFormat = "000"
Range("M11:M46").NumberFormat = "000"
ActiveSheet.Protect Password:="By Jot@"
Application.ScreenUpdating = True
End Sub
'
'Mostrar resultado filtrados, por el boton Filtro en ListBox
Private Sub cbtFiltro_Click() 'LISTO
'Por.Dante Amor http://www.todoexpertos.com/preguntas/6tq6n98o8eefyo4j/arreglar-la-macro-para-filtrar-con-el-textbox?nid=gcqp5uuggnw63hkphks99g6ma4qp9tm5gso6jgulabr3&utm_source=todoexpertos&utm_medium=EmailNotification&utm_campaign=AskerQuestion_ExpertMessageAdded
If OptionButton1 Then
Call FiltrarLista2("B", "K", "C", "D") 'inicio y fin de rango y filtrar por columna C y D
ElseIf OptionButton2 Then
Call FiltrarLista2("M", "V", "N", "O") 'inicio y fin de rango y filtrar por columna N y O
Else
'Si no existe ningun Option seleccionado, manda mensaje
MsgBox "selecciona una página", vbCritical, "Selección"
End If
End Sub
'Activar la (linea) del rango (OptionButton) elegido.ESTA EN VEREMOS
Private Sub Lista2_Click()
Range("a2").Activate
Cuenta = Lista2.ListCount
Set rango = Range("A1").CurrentRegion
For i = 0 To Cuenta - 1
If Lista2.Selected(i) Then
Valor = Lista2.List(i)
rango.Find(what:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
End If
Next i
End Sub
'Filtrado con los OptionButton LISTO
'Nuevo por Dante
Private Sub OptionButton1_Click()
Call FiltrarLista2("B", "K", "C", "D") 'inicio y fin de rango y filtrar por columna C y D
End Sub
Private Sub OptionButton2_Click()
Call FiltrarLista2("M", "V", "N", "O") 'inicio y fin de rango y filtrar por columna N y O
End Sub
Sub FiltrarLista2(col1, col2, col3, col4, Optional verifica As Boolean)
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Lista Repuestos")
Set h2 = Sheets("filtro")
h2.Unprotect Password:="By Jot@"
h2.Cells.Clear 'Contents
Lista2.RowSource = ""
fila = 46
h1.Range("B10:K10").Copy h2.Range("A1")
j = 2
For i = 11 To 46
If Cells(i, col1) <> "" And _
UCase(h1.Cells(i, col3) & h1.Cells(i, col4)) Like "*" & UCase(txtFiltro) & "*" Then
h1.Range(col1 & i & ":" & col2 & i).Copy h2.Cells(j, "A")
h2.Cells(j, "K") = i
j = j + 1
End If
Next
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If u2 > 1 Then
Lista2.RowSource = h2.Name & "!A2:K" & u2
Else
If verifica = False Then
MsgBox "No se encuentra.", vbExclamation, "Inexistente"
End If
End If
h2.Protect Password:="By Jot@"
Application.ScreenUpdating = True
End Sub
'Dar formato al ListBox y traer datos de la tabla
Private Sub UserForm_Initialize()
frmEliminar.Height = 220
frmEliminar.Width = 405
'Ocultar barra de titulo
Dim lngWindow As Long, lFrmHdl As Long
lFrmHdl = FindWindowA(vbNullString, Me.Caption)
lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
lngWindow = lngWindow And (Not WS_CAPTION)
Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
Call DrawMenuBar(lFrmHdl)
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.