Necesito que automáticamente cortar filas que contengan fondo rojo y pegarlas en otra hoja ¿Es posible?

</Hola

Muestra una imagen de la hoja o indica cual columna tiene fondo rojo

El fondo rojo es variable, se tiene que cumplir la condición de una determinada fecha. La idea es que de un rango, cualquier fila que tenga el fondo rojo ( cumpliendo la condición de la fecha) desaparezca de la hoja principal y pase a otra hoja ("caducados")

Muestra una imagen de tu hoja o envíame [email protected]

</Hola

Te paso la macro

Sub copiar()
'//Por Adriel Ortiz
'
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
If j < 4 Then j = 4
For i = 4 To h1.Range("C" & Rows.Count).End(xlUp).Row
    If h1.Cells(i, "C").Interior.ColorIndex = 3 Then
        h1.Rows(i).Copy h2.Range("A" & j)
        h1.Rows(i).Delete
        j = j + 1
    End If
Next i
End Sub

Te paso la macro, copia si la fecha es menor al actual

Sub copiar()
'//Por Adriel Ortiz
'
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
If j < 4 Then j = 4
For i = 4 To h1.Range("C" & Rows.Count).End(xlUp).Row
    If CDate(h1.Cells(i, "C")) < Date Then
        h1.Rows(i).Copy h2.Range("A" & j)
        h1.Rows(i).Delete
        j = j + 1
    End If
Next i
End Sub

Se ha producido el error '13' en tiempo de ejecución:

No coinciden los tipos.

Este es error que me muestra, aparentemente en la siguiente línea

If CDate(h1.Cells(i, "C")) < Date Then

Muchas gracias por tu tiempo

</Hola, veo que tu office es para mac, solo tengo para windows.

Pero haber prueba así

If h1.Cells(i, "C") < Date Then

Ahora sí funciona, pero no las copia todas de una vez, lo hace en 3 veces y cada vez elimina alguna sin pasarlas 😰

Esto sí tiene que funcionar

Sub copiar()
'//Por Adriel Ortiz
'
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
If j < 4 Then j = 4
For i = h1.Range("C" & Rows.Count).End(xlUp).Row To 4 Step -1
    If h1.Cells(i, "C") < Date Then
        h1.Rows(i).Copy h2.Range("A" & j)
        h1.Rows(i).Delete
        j = j + 1
    End If
Next i
MsgBox "Proceso terminado", vbInformation
End Sub

no olvides de valorar la respuesta como Excelente si estas conforme saludos!😰

¡Muchas Gracias! Por lo que visto funciona perfecto

Perdona, me he dado cuenta que en el pegado de los datos, cuando ya tiene datos la hoja de destino, los nuevos datos sobre escriben a los primeros

[Hola 

Quizás en la columnas A de la hoja2 no tengas datos

Cambia esta esta línea

j = h2.Range("A" & Rows.Count).End(xlUp).Row + 1

por esto 

j = h2.Range("C" & Rows.Count).End(xlUp).Row + 1

El problema no es donde pegarlo, sino que cuando haces un segundo pegado se sobre escribe el primero y necesito que quede todo almacenado. Lo que me haría falta es que lo pegara en la primera fila que encuentre vacía. No se, a lo mejor con Do While ActiveCell <> "", pero no consigo que me funcione

Hice la prueba de la macro y funciona, es curioso lo que te pasa, pero haber prueba en hoja nueva