Necesito que automáticamente cortar filas que contengan fondo rojo y pegarlas en otra hoja ¿Es posible?
Me gustaría que automáticamente se corten las filas que cumplen la condición de fondo rojo a otra hoja del libro. El objetivo es que pasen a la segunda sin quedar rastro de estas filas en la hoja base.
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 Subno 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 + 1por 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
¿Has hecho alguna modificación a la macro?
Muestra una imagen de la hoja donde pegas tus datos
