VBA excel eliminar rango de filas duplicadas

[fesero]

buenas, tengo una hoja de excel con el siguiente formato

Nº op Nº Orden Fecha Detalle
1 01-01-10 CARNICERIA LA PERLA
2 01-01-10 ALERTA
3 04-01-10 LOREA
4 05-01-10 LA AGRONOMIA
5 05-01-10 PANADERIA SAN CEFERINO
2 01-01-10 ALERTA
3 04-01-10 LOREA
4 05-01-10 LA AGRONOMIA

el nro de operacion es unico, es decir que las filas que contengan el mismo nro de op significa que son identicas y por lo tanto quiero eliminarlas.

esto es lo que he intentado hacer

Código:

' 
' 
' 
Sub Recorrer_Hojas()
' Recorrer_Hojas Macro
' Macro grabada el 19/03/2010 por Federico Rodriguez
Dim i As Integer, sCeldaActiva As String, sCeldaActivaTexto As String, sCeldaActivaC As String, sCA As String, m As Double, n As Double
i = 2
'For i = 2 To ThisWorkbook.Sheets.Count
     Sheets(i).Select
     [a2].Select
     sCA = ActiveCell.Value
     Do While Not (sCA = "")
         ActiveCell.Offset(1, 0).Select
         sCA = ActiveCell.Value
     Loop
     ActiveCell.Offset(-1, 0).Select
     sCeldaActiva = ActiveCell.Address
     [a3].Select
     sCeldaActivaTexto = ActiveCell.Value
     ActiveCell.Offset(1, 0).Select
     m = Range("A3", (sCeldaActiva)).Count
     On Error GoTo noencontro
     Dim m0 As Range, sbusi As String, sbusf As String
     For iBuscado = 0 To m
        sbusi = ActiveCell.Address
        Set m0 = Range(ActiveCell.Address, sCeldaActiva).Find(What:=sCeldaActivaTexto)
        If m0 Is Nothing Then
            MsgBox "No encontre nada"
        Else
            Range(Cells(m0.Row, 1), Cells(m0.Row, 9)).Delete (xlShiftUp)
            'Set m1 = Range("a3", sCeldaActiva).Find(What:=sCeldaActivaTexto)
            'If m1 Is Nothing Then
            'Else
            '    Range(Cells(m1.Row, 1), Cells(m1.Row, 9)).Delete (xlShiftUp)
            'End If
        End If
        Cells.FindNext(After:=ActiveCell).Activate
        'ActiveCell.Offset(0, -2).Select
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 9)).Select '.Delete (xlShiftUp)
        With Selection.Interior
            .ColorIndex = 34
            .Pattern = xlSolid
        End With
        'ActiveCell.Offset(1, 0).Select
        sCeldaActivaTexto = ActiveCell.Value
        sbusf = ActiveCell.Address
        If sbusi = sbusf Then
            ActiveCell.Offset(1, 0).Select
        End If
     Next

noencontro:

'Next
End Sub

'
'

vale aclarar que esta pensado para recorrer varias hojas.. pero para la prueba esta hecho sobre la hoja 2

[mrocf]

Pero, Federico: ¿Cuál es tu pregunta???

[mrocf]

Suponiendo que lo que quieres es optimizar ese código, te sugiero que en lugar de utilizar un procedimiento tan lento como lo es buscar a lo largo de la columna A los datos duplicados, apliques un Filtro Avanzado (sin duplicados).

Por ejemplo algo así:

Código:

Sub Macro308()
Dim Rng As Range

Set Rng = [a1].CurrentRegion
[a1].Offset(, 1 + Rng.Columns.Count) = "MiCrit"
[a1].Offset(1, 1 + Rng.Columns.Count).Formula = "= COUNTIF(" & _
  [a1].Address & ":" & _
  [a2].Address(False, False) & ", " & _
  [a2].Address(False, False) & ") = 1"

Rng.AdvancedFilter Action:=xlFilterCopy, _
  CriteriaRange:=[a1].Offset(, 1 + Rng.Columns.Count).Resize(2, 1), _
  CopyToRange:=[ea1].Resize(1, Rng.Columns.Count), Unique:=True

[a1].Offset(, 1 + Rng.Columns.Count).Resize(2, 1).ClearContents
With [ea1].CurrentRegion.EntireColumn
  .Copy [a1]
  .Delete
End With

Set Rng = Nothing
End Sub

Estoy suponiendo:

a) Que tu base de datos se inicia en la celda [A1];
b) Que ocupa hasta la columna I;
c) Que la columna J está totalmente vacía

Espero tus comentarios, ¿ok?
Saludos, Cacho.