Sub Eliminar()
Dim a As Long, Vacio As Byte, Tabla(6) As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
' ---&--- PASO 1 - Hay datos ¿?
Datos = 0
For a = 13 To 18
If Not Cells(a, "E") = Empty Then
Tabla(a - 12) = Cells(a, "E"): Datos = Datos + 1
End If
Next
If Vacio = 6 Then Exit Sub
' ---&--- PASO 2 - Hay registros para borrar
Sheets("listado personal").Select
Filas = 2
Borra = 0
While Cells(Filas, "A") <> ""
Marca = 0
For a = 1 To 6
If Len(Tabla(a)) > 0 Then
If Cells(Filas, a) = Tabla(a) Then Marca = Marca + 1
End If
Next
If Marca = Datos Then Borra = Borra + 1
Filas = Filas + 1
Wend
' ---&--- Paso 3 - Confirme borrar
If Borra = 0 Then
MsgBox "No hay ninguna coincidencia", vbCritical + vbOKOnly, "ELIMINAR REGSTROS"
Exit Sub
Else
Opc = MsgBox("Se han encontrado " & Borra & " coincidencias." & vbCrLf & _ "¿Desea eliminar los registros?", _
vbQuestion + vbYesNoCancel + vbDefaultButton3, _
"ELIMINAR REGSTROS")
If Opc <> vbYes Then Exit Sub
End If
' ---&--- Paso 4 - Borrar Filas
While Cells(Filas, "A") <> ""
Marca = 0
For a = 1 To 6
If Len(Tabla(a)) > 0 Then
If Cells(Filas, a) = Tabla(a) Then Marca = Marca + 1
End If
Next
If Marca = Datos Then
Rows(Filas & ":" & Filas).Select: Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
Filas = Filas - 1
Wend
Sheets("Registro").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
