Macro elimina datos repetidos

Hola a los expertos.
Soy nuevo en esto de las macros y necesito ayuda.
Esta macro hace lo que necesito, compara una lista con otra y elimina los elementos repetidos.
Pero si en la lista existen dos o tres o más elementos iguales, tengo que correr nuevamente la macro hasta que no encuentre repetidos, lo que es molesto.
Por favor ayuda con:
1.- Que no me pregunte si quiero borrar el elemento, ya que esa es la razón de la macro.
2.- Como hago para que las listas se encuentren en hojas separadas es decir hoja 1 y hoja 2.
3.- Y lo más importante que no tenga que correr la macro tantas veces sean necesarias para que no queden elementos repetidos.
Yo trabajo con listas de materiales, en cantidades superiores a mil y es bastante el trabajo.
El código es el que sigue:
Sub repetidos()
Range("b1").Select
posicion = 1
While ActiveCell.Value <> ""
valorcomparacion = ActiveCell.Value
Range("a1").Select
salir = "no"
While ActiveCell.Value <> "" And salir = "no"
If ActiveCell.Value = valorcomparacion Then
respuesta = MsgBox("deseas borrar esta entrada", 4, "encontrado")
If respuesta = vbYes Then
Selection.Delete Shift:=xlUp
End If
salir = "si"
Else
ActiveCell.Offset(1, 0).Select
End If
Wend
posicion = posicion + 1
Range("b1").Select
ActiveCell.Offset(posicion - 1, 0).Select
Wend
End Sub
Ayuda por favor.
De ante mano gracias...

1 Respuesta

Respuesta
1
Te quedaría así:
Sub repetidos()
    Hoja1.Select: Range("b1").Select
    posicion = 1
    While ActiveCell.Value <> ""
        valorcomparacion = ActiveCell.Value
        Hoja2.Select: Range("a1").Select
        salir = "no"
        While ActiveCell.Value <> "" And salir = "no"
            If ActiveCell.Value = valorcomparacion Then
                'respuesta = MsgBox("deseas borrar esta entrada", 4, "encontrado")
                'If respuesta = vbYes Then
                    Selection.Delete Shift:=xlUp
                'End If
                'salir = "si"

            Else
                ActiveCell.Offset(1, 0).Select
            End If
        Wend
        posicion = posicion + 1
        Hoja1.Select: Range("b1").Select
        ActiveCell.Offset(posicion - 1, 0).Select
     Wend
End Sub
Te he puesto en negrita lo que he añadido y en cursiva las líneas que he comentado y que ya no son necesarias.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas