Eliminar filas según dos condiciones
Tengo la siguiente macro que no me funciona. Necesito eliminar todas las filas que cumplan dos condiciones. Adjunto macro. Espero su ayuda,
Sub Borra()
Application.ScreenUpdating = False
Range("A2").Select
i = 2
fin = ActiveSheet.Range("C65500").End(xlUp).Row
For i = 2 To fin
If Cells(i, 9) = "33410" And Cells(i, 4) = "C018" Then
Cells(i, 9).Select
Selection.EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
1 respuesta
Te anexo la macro actualizada
Sub Borra()
Application.ScreenUpdating = False
Range("A2").Select
i = 2
fin = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
For i = fin To 2 Step -1
If Cells(i, 9).Text = "33410" And Cells(i, 4).Text = "C018" Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
[
'
.
Muchas gracias, Funciono!! me pudieras explicar el error que tenia la macro, veo que empezaste a eliminar del final hacia el principio?
Hola Dante!
Muchas gracias!! Funciono perfecto!!!! , una preguntica.. si quisiera antes de eliminar la fila copiarla a una nueva Hoja del mismo Libro?
No revisé tu macro, pero supongo que el error es porque estás borrando una fila, por ejemplo borras la fila 9, entonces la fila 10 ahora es la fila 9, el for brinca al siguiente número de fila, es decir, brinca a la fila 10, pero ahora en la fila 10 tienes el dato de la fila 11, significa que el registro de la fila 10 nunca lo revisa. Es por eso que no lo borra. Haciendo el borrado de la última fila hacia la 2, no se tiene ese problema.
Otro detalle es que tienes esto "33410" si lo pones entre comillas, significa que es un texto, entonces en la celda deberá estar como texto, pero si en la celda lo tienes como número entonces no son iguales, para eso puse esto: Cells(i, 9).Text = "33410" , puse .Text para tomar el valor de la celda como texto y compararlo como texto.
Te anexo la macro con los cambios para copiar a otra hoja
Sub Borra()
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja4") 'nombre de hoja origen
Set h2 = Sheets("Hoja5") 'nombre de hoja destino
fin = h1.Range("D" & Rows.Count).End(xlUp).Row
u2 = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
For i = fin To 2 Step -1
If h1.Cells(i, 9).Text = "33410" And h1.Cells(i, 4).Text = "C018" Then
h1.Rows(i).Copy
h2.Rows(u2).PasteSpecial xlValues
u2 = u2 + 1
h1.Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
