Excel como mejorar esta macro de búsqueda
Necesito de su excelente ayuda, tengo esta macro para búsqueda y copia y pega los datos en otra celda, cuando están ordenados no falla pero cuando están desordenados los de la página que dice tablaori, los ciclos se hacen infinitos porque no encuentra el dato como lo puedo mejorar, de antemano se los agradezco mucho ya que si me hace mucha falta esta macro ya que son muchos registros. Reciban un cordial saludo.
Sub Traer()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Contador = 4
Contador2 = 30
encontrado = False
Sheets("RATIFICADO").Select
Do While Cells(Contador, 3) <> "" And Cells(Contador + 1, 3) <> ""
encontrado = False
Cells(Contador + 1, 3).Select
Productor = ActiveCell.Value
Predio = ActiveCell.Offset(0, 1).Value
Sheets("TABLAORI").Select
Cells(Contador2, 1).Select
Productor2 = ActiveCell.Value
Do While encontrado = False
If Productor = Productor2 Then
Sheets("TABLAORI").Select
Cells(Contador2, 1).Select
ActiveCell.Offset(0, 1) = Predio
Contador2 = Contador2 + 1
AuxProductor = Productor2
Nombre = ActiveCell.Offset(0, 2)
Paterno = ActiveCell.Offset(0, 3)
Materno = ActiveCell.Offset(0, 4)
encontrado = True
Else
If Productor = AuxProductor Then
For i = 1 To 25
Cells(Contador2, i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
Cells(Contador2, 1).Value = AuxProductor
ActiveCell.Offset(0, 2) = Nombre
ActiveCell.Offset(0, 3) = Paterno
ActiveCell.Offset(0, 4) = Materno
Contador = Contador - 1
encontrado = False
Else
Contador2 = Contador2 + 1
Predio = ""
Cells(Contador2, 1).Select
ActiveCell.Offset(0, 1) = Predio
Contador = Contador - 1
encontrado = False
End If
End If
Loop
Contador = Contador + 1
Sheets("RATIFICADO").Select
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
P.D. Adjunto como están los datos en excel.