Clico

Public Sub DeleteDuplicatedLines() '*************************************** '*** Code to Remove Duplicated Lines *** '***** E-Mail: clico.tech@gmail.com  ****** '*************************************** Dim r As Long Dim C As Range Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo Erro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If Selection.Rows.Count > 1 Then Set Rng = Selection Else Set Rng = ActiveSheet.UsedRange.Rows End If N = 0 For r = Rng.Rows.Count To 1 Step -1 V = Rng.Cells(r, 1).Value If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then Rng.Rows(r).EntireRow.Delete N = N + 1 End If Next r Erro: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub