Te anexo el código
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 OptionButton1 Then
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")
Range("M46:V46").ClearContents
End If
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 SubUtiliza el archivo versión "D"