Problemas con buqueda de datos vba

Tengo el siguiente código para buscar cierta información bajo ciertos criterios, pero no me entrega los resultados correctos. Creo que el error puede ser la parte del código marcada en negrita.

El código pretende buscar un dato de un archivo (nombre_archivo) en una archivo excel con dos pestañas y extraer información de la pestaña en la que encuentre ese dato. En el archivo donde busca, el dato puede estar más de una vez ya que puede cambiarse de departamento, por lo que la información que he de extraer es aquélla que satisfaga la fecha de realización del evento (es decir, en el archivo nombre_evento el objeto "x" realiza una transacción el 21/01/2012. En el archivo donde se va a buscar se tiene 3 veces el objeto x, con todas las propiedades. La primera línea tiene como fechas 1/01/2012 y 3/01/2012 (entre esas fechas estuvo en ese departamento), la segunda línea tiene como fechas 4/01/2012 y 7/01/2012 y, por último, la tercera, tiene como fechas 8/01/2012 hasta hoy(), por lo tanto a mi sólo me servirían los datos de la tercera fila ya que es la que contiene la fecha que en la que se realizó la transacción.

Si alguien pudiera ayudar, sería grandioso!

De antemano, gracias !

Código:

Sub Resumen_Planillas_Individuales_CE()
Dim x As Integer
Dim celda As Object
Dim y As Integer
Dim z As Integer
Dim rango As Range
Dim rango2 As Range
Dim rango3 As Range
Dim fecha1 As Date
Dim fecha2 As Date
Dim fecha_servicio As Date
Dim newbook As Workbook
Dim newsheet As Worksheet
Dim ruta As String
Dim fila As Integer
Dim auxiliar
Dim GC As String
Dim ceco As String
nombre_archivo = ActiveWorkbook.Name
direccion_archivo = ActiveWorkbook.FullName
MsgBox direccion_archivo
x = WorksheetFunction.CountA(Range("A:A"))
Range("G2:G" & x).NumberFormat = "dd/mm/yyyy"
Range("H2:H" & x).NumberFormat = "[$-F400]h:mm:ss AM/PM"
Set rango = Range("D2:D" & x)
Range("I:I").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlFormanFromLeftOrAbove
Range("I1").Value = "Mes"
Range("I2:I" & x).NumberFormat = "General"
Range("E:E").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlFormanFromLeftOrAbove
Range("E1").Value = "Patente1"
Range("E2:E" & x).NumberFormat = "General"
For Each celda In rango.Cells
Cells(celda.Row, "E") = Left(celda, 7)
Cells(celda.Row, "J") = Month(Cells(celda.Row, "H"))
Next
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlFormanFromLeftOrAbove
Range("F1").Value = "Centro de Costo"
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlFormanFromLeftOrAbove
Range("F1").Value = "Gerencia Corporativa"
Range("F:F").Select
Selection.Insert shift:=xlToRight, copyorigin:=xlFormanFromLeftOrAbove
Range("F1").Value = "Sociedad"
Range("K2:K" & x).NumberFormat = "dd/mm/yyyy"
Set rango = Range("E2:E" & x)
Workbooks.Open ("C:\Users\Usuario\Desktop\CONSUMOS\FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx")
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Activate
Worksheets("Flota Renting").Select
y = WorksheetFunction.CountA(Range("A:A"))
Set rango2 = Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Worksheets("Flota Renting").Range("A2:W" & y)
Range("V2:W" & y).NumberFormat = "dd/mm/yyyy"
Set rango_patentes_renting = Range("A2:A" & y)
Workbooks(nombre_archivo).Activate
On Error Resume Next
For Each celda In rango.Cells
fecha_servicio = Cells(celda.Row, "K")
If IsError(Application.VLookup(celda.Value, rango2, 5, False)) = False Then
If celda = Application.Lookup(celda, rango_patentes_renting) Then
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Activate
Worksheets("Flota Renting").Select
Selection.Find(What:=celda.Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
fila = ActiveCell.Row
If fecha_servicio >= Cells(fila, "V") And fecha_servicio <= Cells(fila, "W") Then
GC = Cells(fila, "E")
ceco = Cells(fila, "T")
Workbooks(nombre_archivo).Activate
Cells(celda.Row, "G") = GC
Cells(celda.Row, "H") = ceco
Else
Cells.FindNext(After:=ActiveCell).Activate
fila = ActiveCell.Row
GC = Cells(fila, "E")
ceco = Cells(fila, "T")
Workbooks(nombre_archivo).Activate
Cells(celda.Row, "G") = GC
Cells(celda.Row, "H") = ceco
End If
End If
Else
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Activate
Worksheets("Flota Propia Operativa").Select
z = WorksheetFunction.CountA(Range("A:A"))
Set rango3 = Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Worksheets("Flota Propia Operativa").Range("A2:S" & z)
Range("R2:S" & z).NumberFormat = "dd/mm/yyyy"
Set rango_patentes_propios = Range("A2:A" & z)
Workbooks(nombre_archivo).Activate
fila = ActiveCell.Row
If celda = Application.Lookup(celda, rango_patentes_propios) Then
Workbooks("FLOTA RENTING - PROPIA OPERATIVA 04-02-2013.xlsx").Activate
Worksheets("Flota Propia Operativa").Activate
Selection.Find(What:=celda, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
fila = ActiveCell.Row
If fecha_servicio >= Cells(fila, "R") And fecha_servicio <= Cells(fila, "S") Then
GC = Cells(fila, "C")
ceco = Cells(fila, "P")
Workbooks(nombre_archivo).Activate
Cells(celda.Row, "G") = GC
Cells(celda.Row, "H") = ceco
Else
Cells.FindNext(After:=ActiveCell).Activate
fila = ActiveCell.Row
GC = Cells(fila, "C")
ceco = Cells(fila, "P")
Workbooks(nombre_archivo).Activate
Cells(celda.Row, "G") = GC
Cells(celda.Row, "H") = ceco
End If
End If
End If
If UCase(Left(Cells(rango.Row, "H"), 3)) = "Z10" Then Cells(celda.Row, "F") = 1000
If UCase(Left(Cells(rango.Row, "H"), 3)) = "Z20" Then Cells(celda.Row, "F") = 2000
If UCase(Left(Cells(rango.Row, "H"), 3)) = "Z31" Then Cells(celda.Row, "F") = 3100
If UCase(Left(Cells(rango.Row, "H"), 3)) = "Z41" Or UCase(Left(Cells(rango.Row, "H"), 4)) = "Z041" Then Cells(celda.Row, "F") = 4100
If UCase(Left(Cells(rango.Row, "H"), 3)) = "Z42" Or UCase(Left(Cells(rango.Row, "H"), 4)) = "Z042" Then Cells(celda.Row, "F") = 4200
If UCase(Left(Cells(rango.Row, "H"), 3)) =...

Añade tu respuesta

Haz clic para o