Macro para copiar filas con condición en otras hojas
Tengo una macro que colorea las filas dependiendo de una condición para que luego otra macro las pase a otras hojas con el mismo nombre de la condición dependiendo del color que tengan, las macros son estas:
Sub ColorearFilas()
Dim n As Integer
Dim reg As Excel.Range
For n = 6 To 10000
If Range("E" & n) = "Condicion1" Then
Worksheets("Hoja1").Range("A" & n, "M" & n).Interior.Color = RGB(0, 255, 0)
Else
If Range("E" & n) = "Condicion2" Then
Worksheets("Hoja1").Range("A" & n, "M" & n).Interior.Color = RGB(192, 192, 192)
Else
If Range("E" & n) = "Condicion3" Then
Worksheets("Hoja1").Range("A" & n, "M" & n).Interior.Color = RGB(128, 128, 128)
Else
End If
End If
End If
Next
End SubSub copiafila_Con_Condicion1()
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Condicion1")
h1.Select
ini = "A"
fin = "M"
For i = 2 To h1.Range(ini & Rows.Count).End(xlUp).row
si = 0
For j = 1 To Range(fin & 1).Column
Cells(i, j).Select
If Cells(i, j).Interior.ColorIndex = 4 Then
si = 1
Else
si = 0
End If
Next
If si = 1 Then
Range(ini & i & ":" & fin & i).Select
h1.Range(ini & i & ":" & fin & i).Copy h2.Range(ini & h2.Range(ini & Rows.Count).End(xlUp).row + 1)
Selection.Delete Shift:=xlUp
i = i - 1
End If
Next
End SubTengo tres problemas con esto, el primero es que esta limitado a 10000 registros, el segundo es que tarda demasiado ya que va revisando condición por condición si tengo 10000 registros revisa los 10000 tres veces y el tercer problema es que no se como poner para que pase los registros que no tienen datos en la columna "B" y los pase a otra hoja llamada "SIN DATOS"
Necesito que no tarde tanto ya que aveces se cuelga (primero porque colorea los 10000 registros por condición y segundo porque revisa condición por condición los 10000 registros, es decir pasa 4 veces los 10000 registros) y pasar los registros que no tienen datos a otra hoja.
1 Respuesta
Lo que no hace falta en la 2da macro, es que evalúe el color col x col, considerando que la 1er macro colorea el rango completo. Es decir que con comparar el color de A & i alcanza sin pasar x el bucle de la variable 'j'.
No sé cómo es el proceso, pero si uno se ejecuta a continuación del otro, podrías hacerlo todo en un mismo paso, si cumple la condición:
- Colorear el rango A:M
-Pasarlo a la otra hoja
Si no cumple ninguna de las 3 o sea si está vacía pasa a la otra hoja.
Avisame si necesitas ayuda para armar 1 sola macro para todo.
Muchas gracias por tu respuesta elsamatilde, y la verdad si necesito ayuda para realizar esta macro, espero me puedas ayudar.
Saludos.
Bien, aquí te la deja tal como se interpreta de tu pedido:
Si B está vacío se copia en hoja Sin datos (h4)
Si cumple condición 1 a 3 se copia en sus respectivas hojas. (h1, h2, h3)
Si se trata de la condición 3, se colorea la fila, en el resto de los casos se elimina la fila en rango A:M.
Sub ColorearFilas()
'x Elsamatilde
Dim n As Long
'definimos las hojs
Set h1 = Sheets("Condicion1")
Set h2 = Sheets("Condicion2")
Set h3 = Sheets("Condicion3")
Set h4 = Sheets("SIN DATOS")
For n = 6 To 10000
'evalua si col B no tiene datos, en ese caso pasa a otra hoja
If Range("B" & n) = "" Then
Range("A" & n & ":M" & n).Select
Selection.Copy Destination:=h4.Range("A" & h4.Range("A" & Rows.Count).End(xlUp).Row + 1)
'se elimina el rango A:M
Selection.Delete Shift:=xlUp
n = n - 1
'si se cumple la condición 1ro se lo copia en su hoja y luego se elimina-NO SE COLOREA
ElseIf Range("E" & n) = "Condicion1" Then
Range("A" & n & ":M" & n).Select
Selection.Copy Destination:=h1.Range("A" & h1.Range("A" & Rows.Count).End(xlUp).Row + 1)
'se elimina el rango A:M
Selection.Delete Shift:=xlUp
n = n - 1
ElseIf Range("E" & n) = "Condicion2" Then
Range("A" & n & ":M" & n).Select
Selection.Copy Destination:=h2.Range("A" & h2.Range("A" & Rows.Count).End(xlUp).Row + 1)
'se elimina el rango A:M
Selection.Delete Shift:=xlUp
n = n - 1
ElseIf Range("E" & n) = "Condicion3" Then
'en este caso solo se colorea
Range("A" & n & ":M" & n).Select
Selection.Copy Destination:=h3.Range("A" & h3.Range("A" & Rows.Count).End(xlUp).Row + 1)
Selection.Interior.Color = RGB(128, 128, 128)
End If
Next
End SubComentame el resultado.
Sdos!
Hola ElsaMatildequisiera hacerle una consulta adicional de ser posible, quisiera saber si en un formulario se puede agregar un textbox donde se registre un dato cualquiera y este dato reemplace en un rango de la hoja activa, agradeceré el apoyo con dicha información - Cristian Rodriguez