Eliminar filas entre dos Valores
Hola Elsa, de nuevo (espero que la última)vuelvo a acudir a ti. La petición es:
En cualquier celda de la columna (F), escribo "A" y más abajo "B". Necesitaría que se eliminarán las filas del rango que delimitan ambas (su filas no deberían eliminarse).
Muchas Gracias, un Saludo.
En cualquier celda de la columna (F), escribo "A" y más abajo "B". Necesitaría que se eliminarán las filas del rango que delimitan ambas (su filas no deberían eliminarse).
Muchas Gracias, un Saludo.
1 respuesta
Respuesta de Elsa Matilde
1
Te adjunto la macro solicitada, que colocara´s en un módulo:
Sub MacroElimina_filas_intermedias()
'macro desarrollada por Elsamatilde el 15/12/06
Dim ultfila, fila1, fila2 As Integer
Dim ctrl As Byte
ultfila = Range("F65536").End(xlUp).Row + 1
Range("F2").Select
While ActiveCell.Row <= ultfila And ctrl = 0
If ActiveCell.Value = "A" Then
fila1 = ActiveCell.Row + 1
ctrl = 1
End If
ActiveCell.Offset(1, 0).Select
Wend
If ctrl = 0 Then
MsgBox "No se encontró celda con valor A"
Exit Sub
End If
ctrl = 0
While ActiveCell.Row <= ultfila And ctrl = 0
If ActiveCell.Value = "B" Then
fila2 = ActiveCell.Row - 1
ctrl = 1
End If
ActiveCell.Offset(1, 0).Select
Wend
If ctrl = 0 Then
MsgBox "No se encontró celda con valor B"
Exit Sub
End If
If fila2 < fila1 Then
MsgBox "No se encuentran filas para eliminar entre A y B"
Exit Sub
End If
Range(fila1 & ":" & fila2).Select
Selection.EntireRow.Delete
End Sub
Saludos
Elsa
** Para estas fiestas regalate .... el manual de las 400Macros explicadas paso a paso en español.
http://es.geocities.com/lacibelesdepunilla/manuales_aplicaciones
Sub MacroElimina_filas_intermedias()
'macro desarrollada por Elsamatilde el 15/12/06
Dim ultfila, fila1, fila2 As Integer
Dim ctrl As Byte
ultfila = Range("F65536").End(xlUp).Row + 1
Range("F2").Select
While ActiveCell.Row <= ultfila And ctrl = 0
If ActiveCell.Value = "A" Then
fila1 = ActiveCell.Row + 1
ctrl = 1
End If
ActiveCell.Offset(1, 0).Select
Wend
If ctrl = 0 Then
MsgBox "No se encontró celda con valor A"
Exit Sub
End If
ctrl = 0
While ActiveCell.Row <= ultfila And ctrl = 0
If ActiveCell.Value = "B" Then
fila2 = ActiveCell.Row - 1
ctrl = 1
End If
ActiveCell.Offset(1, 0).Select
Wend
If ctrl = 0 Then
MsgBox "No se encontró celda con valor B"
Exit Sub
End If
If fila2 < fila1 Then
MsgBox "No se encuentran filas para eliminar entre A y B"
Exit Sub
End If
Range(fila1 & ":" & fila2).Select
Selection.EntireRow.Delete
End Sub
Saludos
Elsa
** Para estas fiestas regalate .... el manual de las 400Macros explicadas paso a paso en español.
http://es.geocities.com/lacibelesdepunilla/manuales_aplicaciones
