Buscar y cortar y pegar fila que tenga en la columna O numero de cuenta
Dante nuevamente dándole seguimiento a este tema requiero de tu apoyo con el fin de ayudarme a modificar la macro en donde las celdas se encuentren con espacios ejecutar la macro, dado que algunos campos los tengo con este detalle.
Muchas gracias Dante de antemano
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
1 Respuesta
Respuesta de Dante Amor
1
Anexo la macro actualizada, realiza tus pruebas y me comentas.
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
If InStr(1, UCase(h1.Cells(i, "S")), "EXTRAORDINARIO") > 0 Then
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
ElseIf InStr(1, UCase(h1.Cells(i, "S")), "REPROBADO") > 0 Then
h1.Rows(i).Copy h2.Rows(u)
u = u + 1
h1.Rows(i).Delete
End If
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 SubS a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta.
Dante me reemplaza el primer registro o fila que tengo, en pocas palabras me la coloca en la primera fila de A2
Reemplaza la letra "A" en la línea
Col = "A" 'columna conn datos
Por la letra "S", te debe quedar así:
col = "S" 'columna conn datos
S a l u d o s
