Duda de cortar pendientes y pegar en otra hoja

Dante me ayudaste con esta macro sin embargo tengo un pequeño problema, cuando encuentra un problema cuando encuentra en la columna un estatus de Extraordinario quiero que de esa fila que me va a cortar me busque en la columna O el numero de cuenta y busque en toda la hoja si existe el folio, si existe cortar y pegar en la hoja de pendientes, asi como el segundo bloque si es un se encuentra un CEROS buscar en la columna O de toda la hoja y cortar y pegar en la hoja de pendientes.

Una disculpa pero omiti el dato de numero de cuenta

Sub CortarPendientes()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("escuela")
    Set h2 = Sheets("pendientes")
    '
    u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
    For i = h1.Range("S" & Rows.Count).End(xlUp).Row To 1 Step -1
        Select Case UCase(h1.Cells(i, "S"))
            Case "EXTRAORDINARIO", "REPROBADO"
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    '
    u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
    For i = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row To 1 Step -1
        Select Case h1.Cells(i, "Q")
            Case "", 0
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    MsgBox "Terminado", vbInformation
End Sub

1 Respuesta

Respuesta
1

No me queda clara la explicación:

Dices: "cuando encuentra en la columna un estatus de Extraordinario quiero que de esa fila que me va a cortar me busque en la columna O el numero de cuenta y busque en toda la hoja si existe el folio"

Entiendo lo siguiente:

1. Si dice "Extraordinario", entonces que tome la cuenta que está en la columna O, hasta allí es lo que entiendo.

2. Luego dices: "y busque en toda la hoja si existe el folio", ¿en cuál hoja? ¿En cuál columna? ¿Cuál folio?

3. De lo siguiente no entendí: "asi como el segundo bloque si es un se encuentra un CEROS buscar en la columna O de toda la hoja y cortar y pegar en la hoja de pendientes", puedes explicarlo nuevamente con algún ejemplo.

S a l u d o s . D a n t e   A m o r.

si claro te explico nuevamente con mucho gusto

1.-  Si dice "Extraordinario", entonces que tome la cuenta que está en la columna O, hasta allí es lo que entiendo.

2.- debe de buscar todo el numero de cuenta que existe en la columna O que la busque en toda la hoja de "Escuela" y tambien me corte y me lo pegue en la hoja de pendientes en la ultima fila disponible.

3.- El segundo bloque dice que cuando encuentre un cero corta y pega ala  hoja de pendientes. pero quiero que me busque igual el numero de cuenta que busque en toda la hoja y me corte los dos registros y me los pegue en la hoja de pendientes.

Ejemplo

Lo mismo sucede para el segundo  bloque si encuentra un Ceros en la columna Q buscara el numero de cuenta en la Columna O si existe un numero de cuenta y cortar y pegar los dos registros en Pendientes.

Muchas gracias Dante por la paciencia

Para la primera parte.

Si dice "Extraordinario" que busque la cuenta en toda la columna "O" si encuentra varios registros que copie los registros en "pendientes" y que los elimine de la hoja "escuela"?

Para la segunda parte, crea una nueva pregunta.

Si es así, entonces prueba con la siguiente macro la parte1

Sub CortarPendientes()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("escuela")
    Set h2 = Sheets("pendientes")
    '
    u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
    For i = h1.Range("S" & Rows.Count).End(xlUp).Row To 1 Step -1
        Select Case UCase(h1.Cells(i, "S"))
            Case "EXTRAORDINARIO"
                cuenta = h1.Cells(i, "O")
                For j = h1.Range("O" & Rows.Count).End(xlUp).Row To 1 Step -1
                    If h1.Cells(j, "O") = cuenta Then
                        h1.Rows(j).Copy h2.Rows(u)
                        u = u + 1
                        h1.Rows(j).Delete
                    End If
                Next
            Case "REPROBADO"
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    '
    u = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row + 1
    For i = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row To 1 Step -1
        Select Case h1.Cells(i, "Q")
            Case "", 0
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    MsgBox "Terminado", vbInformation
End Sub

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta.

Gracias Dante pero funciona parcialmente hay un detalle me los corta de la hoja pero no me los pega en la hoja de pendientes.

No se donde se pegan esos datos solo ya desapareciaron

La segunda cuestión es que tengo espacios antes del Extraordinario y Reprobado, se puede hacer algo al respecto?

Revisa en la hoja de pendientes hasta el final, presiona las teclas Control + Fin

Tal vez puso los datos muy abajo por eso no los ves

Es correcto ya los encontré me los puso hasta la fila 63, pero pudieras ayudarme con el detalle de considerar espacios en Antes de Extraordinario o reprobado y la otra que me los pegue en la ultima fila disponible por favor de Pendientes.

Disculpa la lata

¿Dime cuál columna siempre va a tener datos?

Cambia en la macro la letra "A" por la columna que siempre va a tener datos en esta línea:

col = "A"   'columna con datos

Sub CortarPendientes()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("escuela")
    Set h2 = Sheets("pendientes")
    '
    col = "A"   'columna conn datos
    '
    u = h2.Range(col & Rows.Count).End(xlUp).Row + 1
    '
    For i = h1.Range("S" & Rows.Count).End(xlUp).Row To 1 Step -1
        Select Case UCase(h1.Cells(i, "S"))
            Case "EXTRAORDINARIO"
                cuenta = h1.Cells(i, "O")
                For j = h1.Range("O" & Rows.Count).End(xlUp).Row To 1 Step -1
                    If h1.Cells(j, "O") = cuenta Then
                        h1.Rows(j).Copy h2.Rows(u)
                        u = u + 1
                        h1.Rows(j).Delete
                    End If
                Next
            Case "REPROBADO"
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    '
    u = h2.Range(col & Rows.Count).End(xlUp).Row + 1
    For i = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row To 1 Step -1
        Select Case h1.Cells(i, "Q")
            Case "", 0
                h1.Rows(i).Copy h2.Rows(u)
                u = u + 1
                h1.Rows(i).Delete
        End Select
    Next
    MsgBox "Terminado", vbInformation
End Sub

S a l u d o s

Dante perdón pero me perdí,

  1. La columna es la ES, pero lo que yo me refiero es que mi celda tiene espacios antes de la palabra " Extraordinario" o " Reprobado" espero me explique mejor
  2. Una disculpa

Para que la macro identifique cuál es la última fila con datos, le tengo que decir cuál columna siempre va a tener datos, por siempre me refiero a que esa columna sin importar la información que tenga siempre va a existir un dato.

Si en la columna "S" a veces tienes datos y a veces no tienes datos, esa columna no sirve. Tienes que poner una columna en la que siempre existan datos.

¿Me explico?

Te entiendo perfectamente y si tiene datos, toda las filas que necesito, pero lo que me quiero a dar a entender es que en las celdas tiene espacios seguido de la palabra "       Extraordinario" "    Reprobado" entre comillas estoy colocando un dato con espacios pero si tiene la palabra y no se encuentra vacia.

¿Y esos espacios no los puedes eliminar?

¿O son necesarios?

Tendría que eliminar registros por registros, dado que así me dan mi base de datos en excel la escuela.

Ya no entiendo, ¿qué es lo que necesitas?

Me dices que las líneas se fueron hasta la fila 63, ¿ese es el problema?

¿O el problema es que en la celda tienes espacios " Extraordinario "?

Son dos cosas diferentes.

Si la macro ya funciona y ahora quieres que resuelva lo de los espacios en la celda, entonces crea una nueva pregunta.

S a l u d o s 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas