Copiar datos a columna de fecha respectiva

[GR77]

Buenos días

Me gustaría que me ayudaran a modificar la macro que tengo, para hacer lo siguiente:

Tengo dos hoja Base y Resumen, de la hoja Base deseo ir analizando celda por celda de la columna E:K y si la celda es igual a 100, me copie ese registro a la hoja Resumen en el día correspondiente, ademas de copiar los datos de la columna A:D de la hoja Base.

Adjunto un pequeño ejemplo con el código de la macro que tengo y un ejem de como me debería quedar

Agradezco de antemano su apoyo y/o ayuda

Saludos

prueba07122019.xlsm

[Antoni]

Si puedo, mañana te subo algo.

[JSDJSD]

Hola GR77, prueba el adjunto haber si es lo que necesitas

prueba07122019(1).xlsm

[GR77]

Gracias Antoni por tu interés para ayudarme.

JSDJSD como podría modificar la parte de que cuando se repite un código, hice una prueba repitiendo el código D5 y le puse 100 el día 19/10/2019 en la fila 22 al correr la macro, le cambia al ultimo código con 100 (w258) por D5 y le asigna el 100 al día 19/10/2019.

Ya intenté modificar la línea Hoja2.cells(ufh2 + 1, 1) = codigo pero no me funcionó

Agradezco de antemano tu ayuda.

Saludos

[Antoni]

Casi, casi, lo mismo que JSDJSD:

Sub Resumen()
Application.ScreenUpdating = False
Hoja2.Range("A12:AI" & Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1).ClearContents
For x = 10 To Hoja1.Range("A" & Rows.Count).End(xlUp).Row
   For y = 5 To 11
      Set código = Hoja2.Columns("A").Find(Hoja1.Range("A" & x), , xlValues, xlWhole)
      If Hoja1.Cells(x, y) = 100 Then
         Set fecha = Hoja2.Rows(10).Find(Hoja1.Cells(8, y), , xlValues, xlWhole)
         If Not fecha Is Nothing Then
            If Not código Is Nothing Then
               fila = código.Row
            Else
               fila = Hoja2.Range("A" & Rows.Count).End(xlUp).Row + 1
               Hoja2.Range("A" & fila) = Hoja1.Range("A" & x)
               Hoja2.Range("B" & fila) = Hoja1.Range("B" & x)
               Hoja2.Range("C" & fila) = Hoja1.Range("C" & x)
               Hoja2.Range("D" & fila) = Hoja1.Range("D" & x)
            End If
            Hoja2.Cells(fila, fecha.Column) = 100
         End If
      End If
   Next
Next
Hoja2.Activate
End Sub

 

[JSDJSD]

Hola GR77, prueba el adjunto y comenta, pero ¡¡ojo¡¡ no dejes de probrar el código que te comparte el Maestro Antoni y comentarlo también.

prueba07122019(2).xlsm

[GR77]

Buen día y saludos a todos

Antoni y JSDJSD, mil gracias por su tiempo y apoyo, las macros de ambos funcionan muy bien

Por favor pueden cerrar el tema, tema solucionado 

Saludos