Macro para Eliminar filas sobrantes después de aplicar filtro

Se me ocurren 2 opciones, para hacerlo más dinámico.

Opción 1:

Se puede automatizar con un filtro avanzado, pero tienes que poner en otra hoja el criterio o los criterios con los que vas a hacer el filtro. Una vez realizado el filtro se copia la información resultante en una tercera hoja.

Para poder hacer el filtro, la información tiene que tener encabezados y todos los encabezados tienen que ser diferentes.

Opción 2.

Con autofiltros, igual que la opción anterior se tendrían que escribir los criterios en una hoja, luego la macro tomaría esos criterios y aplicaría autofiltros columna por columna.

En cualquier opción, aunque no se utilicen el filtro avanzado o los autofiltros tendrás que escribir en alguna parte la columna que quieres filtrar y el criterio con el que quieres filtrar.

Para que te des una idea tendrías que poner los criterios como se muestra en la imagen:

Como puedes observar en la imagen, puedes poner diferentes criterios. La macro leería los datos de la Hoja1, tomaría los criterios de la Hoja2 y pondría los resultados en la Hoja3.

Pero lo principal, es que antes de ejecutar la macro debes capturar los criterios.

Si no quieres aplicar un filtro sobre alguna columna, simplemente en la hoja2 de criterios abajo del título, lo dejas en blanco.

Si quieres que haga la macro envíame tu archivo para prepararla. Dime algunos ejemplos de criterios que regularmente ocupas.

Hola, gracias por tu ayuda.

Ayer grabé esta macro que hace que el proceso sea muy rápido:

Sub Eliminar_filas_resto_zonas()
'
' Eliminar_filas_resto_zonas Macro
'

'
ActiveSheet.Range("$A$7:$F$6500").AutoFilter Field:=3, Criteria1:=Array("0" _
, "8011", "8020", "8028", "8029", "8055", "8057", "8063", "8065", "8075", "8077", _
"9705", "9706", "9707", "9708", "9709", "9710", "9711", "9712", "9714", "9715", _
"9716", "9884", "9999"), Operator:=xlFilterValues
Rows("8:10279").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Range("$A$7:$F$39").AutoFilter Field:=3
ActiveWindow.SmallScroll Down:=-12
Range("D8").Select
End Sub

Ahora bien, este proceso sólo me sirve para aquellos excel en que el filtrado se hace en la celda C7, y lo que me gustaría es poder correr la macro desde cualquier celda, no se si posicionandome en ella previamente o indicándole la intentar a la macro previo imputbox... Creo que lo que marco en negrita es la intentar del filtrado que me interesaba en este excel, pero no siempre es igual, la variedad de archivos que recibo es lo que hace que necesite una macro variable en la intentar para aplicar el filtro.

Este es el archivo donde grabé la macro, hago el filtro en C7. Pero en esta otra imagen puedes ver como necesito hacer la macro en A1

Para mi lo importante es la velocidad con la que me lo hace. He visto macros que eliminas filas que no cumplen determinadas condiciones, pero veo que verifica la condición una a una y en archivos con miles de filas es muy lento, tardo menos yo haciéndolo manualmente.

No se si lo que pido es ciencia-ficción. En todo caso, muchas gracias por tu ayuda.

Saludos.

Prueba con lo siguiente, solamente tienes que posicionarte en la celda donde va a iniciar el filtro, en tus ejemplos serían las celdas C7 o A1, siempre te tienes que posicionar en al celda que tiene el título.

Sub Eliminar_filas_resto_zonas()
'Mod.Por Dante Amor
    Set h1 = ActiveSheet
    h1.AutoFilterMode = False
    celda = ActiveCell.Address
    c = ActiveCell.Column
    uc = h1.UsedRange.SpecialCells(11).Address
    fi = ActiveCell.Row + 1
    h1.UsedRange.AutoFilter Field:=c, _
        Criteria1:=Array("0", "8011", "8020", "8028", "8029", "8055", _
                   "8057", "8063", "8065", "8075", "8077", "9705", _
                   "9706", "9707", "9708", "9709", "9710", "9711", _
                   "9712", "9714", "9715", "9716", "9884", "9999"), _
                   Operator:=xlFilterValues
    '
    On Error Resume Next
    Range("A" & fi, uc).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    '
    If Err.Number <> 0 Then
        MsgBox "No hay filas a borrar", vbExclamation, "Error: " & Err.Number & " " & Err.Description
    End If
    '
    h1.UsedRange.AutoFilter Field:=c
    Range(celda).Select
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

¡Gracias!

Genial. Sólo me da error cuando hay selecciones superpuestas, que no se lo que son ni como las evito, pero en la mayoría de ocasiones el resultado es excelente. Muchísimas gracias!