Macro eliminar todos los registros duplicados (no dejar ninguno)
Tengo unos datos en una hoja llamada "PEDIDOFAC", y quiero copiar todos los datos de dicha hoja a otra llamada "PEDIDOPEND", y luego eliminar TODOS los datos repetidos en la columna B, el problema que tengo es que la macro me elimina los repetidos, pero me deja uno solo de dichos datos, y yo quiero que si el dato está repetido, se eliminen todos, es decir el original y también los repetidos. La macro es la siguiente:
Sub EliminaDuplicados()
Sheets("PEDIDOFAC").Range("A1:Z400000").Copy Destination:=Sheets("PEDIDOPEND").Range("A1")
Application.CutCopyMode = False
'se quitan los datos duplicados, pero deja uno
Sheets("PEDIDOPEND").Select
Range("B1").Select
Do While Not IsEmpty(ActiveCell)
x = WorksheetFunction.CountIf(Range("B:B"), ActiveCell)
If x > 1 Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Range("A1").Select
End Sub
1 Respuesta
Te anexo la macro actualizada
Sub EliminaDuplicados()
'Act.Por.Dante Amor
Application.ScreenUpdating = False
Sheets("PEDIDOFAC").Range("A1:Z400000").Copy Sheets("PEDIDOPEND").Range("A1")
Sheets("PEDIDOPEND").Select
u = Range("B" & Rows.Count).End(xlUp).Row
Range("AA1:AA" & u) = "x"
For i = 1 To u
If Application.CountIf(Range("B:B"), Cells(i, "B")) > 1 Then
Cells(i, "AA") = ""
End If
Next
Range("AA1:AA" & u).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("AA:AA").Clear
End Sub