Macro para Comprar dos Rangos e insertar una fila

Como puedo construir una macro que compare dos rangos de fechas en hojas diferentes teniendo en cuenta que en la hoja1 tengo el rango del 15/07/2009 hasta el 16/08/2009 y en la hoja2 tengo valores entre ese rango, cuando se realice la comparación en la hoja2 y haga falta una fecha inserte una fila donde corresponde.
Hoja 1 Hoja 2
17/07/2009 17/07/2009
18/07/2009 18/07/2009
19/07/2009 21/07/2009 --> Aqui deberia insertar una fila con la fecha 20/07/2009
20/07/2009 22/07/2009

1 Respuesta

Respuesta
2
Para ello inserta un modulo y pegas esta macro y la ejecutas cuando quieras:
Sub Comparar_Insertar_Fila()
Dim valor, celda As String
Sheets("Hoja2").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
celda = ActiveCell.Value
Sheets("Hoja1").Select
Range("A1").Select
Do While ActiveCell.Value <> ""
valor = ActiveCell.Value
Sheets("Hoja2").Select
Range("A1").Select
Do While ActiveCell.Value <> celda
If ActiveCell.Value = valor Then Exit Do
If ActiveCell.Value < valor And ActiveCell.Offset(1, 0) > valor Then
ActiveCell.Offset(1, 0).EntireRow.Insert
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
Esta pensada para que los valores de fecha estén en las Col A de cada Hoja, si no es así cambia la referencia a las Columnas.
Pruebalá y me cuentas
>Un saludo
>Julio
Gracias por tu colaboración Julio, podría ser posible que en la macro agregar en la fila la fecha faltante.
Saludos
Oscar
Bien entonces quedaría así:
Sub Comparar_Insertar_Fila()
Dim valor, celda As String
Sheets("Hoja2").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
celda = ActiveCell.Value
Sheets("Hoja1").Select
Range("A1").Select
Do While ActiveCell.Value <> ""
valor = ActiveCell.Value
Sheets("Hoja2").Select
Range("A1").Select
Do While ActiveCell.Value <> celda
If ActiveCell.Value = valor Then Exit Do
If ActiveCell.Value < valor And ActiveCell.Offset(1, 0) > valor Then
ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(1, 0).Value = valor
Exit Do
End If
ActiveCell.Offset(1, 0).Select
Loop
Sheets("Hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
If ActiveCell.Value = "" Then
valor = ActiveCell.Offset(-1, 0).Value
Sheets("Hoja2").Select
Range("A1").End(xlDown).Select
If ActiveCell.Value <> valor And ActiveCell.Value < valor Then
ActiveCell.Offset(1, 0).Value = valor
End If
End If
End Sub
Pruebalá y me cuentas, si te ha servido puntúa y finaliza la consulta. Gracias.
>Un saludo
>Julio
Gracias por tu rápida colaboración Julio, me funciono perfectamente eso era lo que necesitaba, mereces un 100 por la solución.
Finalmente como puedo hacer para que trabaje la macro cuando al lado cambie el código de la persona, me explico:
Código
1101  02/09/2009
1101  03/09/2009
1101 04/09/2009
1101 07/09/2009
1102 04/09/2009
1102 05/09/2009
Gracias
Vamos a ver ahora entiendo que no solo tienes que poner la fecha faltante si no que además en la celda contigua en la izquierda tienes un código y quieres que la macro analice y también lo ponga... podías haber empezado por ahí (esperemos que ahora no me digas que también a la derecha tienes más valores)
Aclarame una duda que me ha surgido, no tendrás los valores del código en la misma celda, esperemos que el código este en la Col A y la fecha en la Col B.Específicamente como tienes los datos, que no me gusta trabajar varias veces para la misma cuestión.
>Un saludo
>Julio

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas