Macro borrar filas
Hola a todos,
a ver si me podéis ayudar con esta macro que me ha surgido.
Lo que quiero hacer es que la macro me vaya recorriendo las celdas por columna en un determinado rango y que si todas las celdas de la misma fila cumplen una condición se elimine esa fila.
Es decir, en la fila 1 si las celdas C1, D1, E1, F1 y G1 están vacías se elimine la fila (estén vacías o cumplan cualquier criterio). Da igual si A1 y B1 estén vacías o contengan lo que sea, así hasta la última fila (esa última fila me la da la columna A, es decir, hasta la última fila que contenga la columna A rellena).
Muchas gracias.
a ver si me podéis ayudar con esta macro que me ha surgido.
Lo que quiero hacer es que la macro me vaya recorriendo las celdas por columna en un determinado rango y que si todas las celdas de la misma fila cumplen una condición se elimine esa fila.
Es decir, en la fila 1 si las celdas C1, D1, E1, F1 y G1 están vacías se elimine la fila (estén vacías o cumplan cualquier criterio). Da igual si A1 y B1 estén vacías o contengan lo que sea, así hasta la última fila (esa última fila me la da la columna A, es decir, hasta la última fila que contenga la columna A rellena).
Muchas gracias.
1 Respuesta
Respuesta de yobert
1
Recibe mis cordiales saludos, la linea de programación que necesitas es la siguiente:
Dim min As Double
Dim j As Double
Sheets("Query2").Activate
min = ActiveSheet.Range("A65536").End(xlUp).row
For j = 0 To min
If j < min Then
i = j + 1
Cells(i, 1).Select
If Cells(i, 3).Value = "" And Cells(i, 4).Value = "" And Cells(i, 5).Value = "" And Cells(i, 6).Value = "" And Cells(i, 7).Value = "" Then
celda = ActiveCell.Address
Selection.EntireRow.Delete
min = ActiveSheet.Range("A65536").End(xlUp).row
If ActiveCell.row <> 1 Then Range(celda).Offset(-1, 0).Select
j = j - 1
Else
ActiveCell.Offset(1, 0).Select
End If
End If
Next
Cells(i, 1).Activate
End Sub
Saludos, espero haberte ayudado, en caso que no entiendas me avisas
Dim min As Double
Dim j As Double
Sheets("Query2").Activate
min = ActiveSheet.Range("A65536").End(xlUp).row
For j = 0 To min
If j < min Then
i = j + 1
Cells(i, 1).Select
If Cells(i, 3).Value = "" And Cells(i, 4).Value = "" And Cells(i, 5).Value = "" And Cells(i, 6).Value = "" And Cells(i, 7).Value = "" Then
celda = ActiveCell.Address
Selection.EntireRow.Delete
min = ActiveSheet.Range("A65536").End(xlUp).row
If ActiveCell.row <> 1 Then Range(celda).Offset(-1, 0).Select
j = j - 1
Else
ActiveCell.Offset(1, 0).Select
End If
End If
Next
Cells(i, 1).Activate
End Sub
Saludos, espero haberte ayudado, en caso que no entiendas me avisas
