Macro para llevar control

Hola! Tengo un libro con muchas hojas, quisiera hacer una macro que haga lo siguiente:
Tengo en una hoja llamada INDICE todas las hojas del libro, en cada hoja del libro la columna G contiene una fecha empezando desde G5, necesito que compare cada una de las celdas con la fecha del día de HOY y si coincide entonces en una Hoja llamada CONTROL copie de esa fila los siguientes datos en el siguiente orden:
En A copie el dato de la columna G
En B copie el dato de la columna B
En C copie el dato de la columna J
En DE copie el dato de la columna D
Y así sucesivamente de manera que la hoja control termine copiando los datos mencionados de las filas que coincidan con la fecha de hoy.
Para explicarme mejor, cada hoja tiene un criterio diferente pero como siempre ingreso datos, al final de la jornada quisiera tener un resumen de todo lo que ingrese en el día, pero como los formatos no coinciden entonces necesito ese orden especifico.
Desde ya gracias por tu ayuda
Respuesta
1
¿Necesitas qué sea en TODAS las hojas del libro o busque en INDICE en la columna G?
¿Desde G5 hasta que celda?
No. Osea en INDICE tengo en la columna A todos los nombres de las hojas donde quiero buscar. Necesito que busque desde G5 hasta la ultima celda ocupada que no se cual es, pero si por ejemplo busca en G5 y G6 esta vacía por ende G7, G8, G9,... Gn, estarán vacías así que a lo que encuentre una vacía puede pasar a la siguiente hoja.
OK
Aquí tienes
Prueba esto
Sub busca()
Application.ScreenUpdating = False
For Each sh In Worksheets
sh.Select
If sh.Name <> "INDICE" And sh.Name <> "CONTROL" Then
Range("G5").Select
Do While Not IsEmpty(ActiveCell)
If Range("G5") = Date Then
valor1 = ActiveCell
valor2 = ActiveCell.Offset(0, -5)
valor4 = ActiveCell.Offset(0, 3)
valor3 = ActiveCell.Offset(0, -3)
Sheets("CONTROL").Select
Range("A65000").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell = valor1
ActiveCell.Offset(0, 1) = valor2
ActiveCell.Offset(0, 2) = valor3
ActiveCell.Offset(0, 3) = valor4
sh.Select
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End If
Next sh
Sheets("Control").Select
Application.ScreenUpdating = True
MsgBox "Procedimiento Finalizado"
End Sub
Saludos y no olvides finalizar la respuestas
Hermano eres lo máximo! Muchísimas gracias, soy nuevo en esto, tu solución no solo es rápida sino que ademas es un secuencia corta que no ocupa mucha memoria. Gracias!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas