Macros que filtre por multiples criterios y saque la información en hojas distintas

[José Antonio García Sanz]

Tengo un Excel con una hoja e información en 12 columnas, y quiero con una macro que me filtre información y me lo meta en las distintas hojas que inicialmente tengo vacías.

Toda la info está en la hoja1, y quiero desglosar la información en las 6 hojas vacías.

PO Material Material Description Quantity Mat. Doc. Sales Ord. MvT Pstng Date S Plnt Reference SLoc

5200020999 1AB375380005 ALU XFP S-64-2B/10GBE BASE-E -40/+85 20 5009108038 101 01/04/2014 EG03 MG02

101 LIBRE -> filtra columna G todo lo que sea “101”, de lo “101”, todo lo que la columna J sea “EG04” y “EG09”, y del resto saca lo que la columna S esté vacía. Es decir, lo “101” con J “EG04” y “EG09 completo, y del resto de 101 sólo lo que la columna S esté vacía.

102 LIBRE -> filtra columna G todo lo que sea “102” y que la columna S esté vacía

101 ALOCADO -> filtra columna G todo lo que sea “101” y que la columna S sea “E”, y de ahí quita todo lo que en columna J sea “EG04” o “EG09

102 ALOCADO -> filtra columna G todo lo que sea “102” y que la columna S sea “E”

RET -> filtra columna G todo lo que sea “651”

EC01 501 -> filtra columna G todo lo que sea “501”

Las hojas 101 LIBRE y 101 ALOCADO no las saco, y tampoco sé cómo puedo mantener los títulos de las columnas en las hojas (al ejecutar la macro pierdo todas)

Esto es lo que tengo... si alguien me puede echar un mano, se lo agradezco mucho.

Sub Filtrar()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio 101 LIBRE EG04 y EG09 completas y resto con E (no me sale)

Selection.AutoFilter Field:=7, Criteria1:="101"

Selection.AutoFilter Field:=10, Criteria1:="EG04", Operator:=xlOr, Criteria2:="EG09"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("101 LIBRE").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros()

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Filtrar2()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio 102 libre sin E

Selection.AutoFilter Field:=7, Criteria1:="102"

Selection.AutoFilter Field:=9, Criteria1:=""

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("102 LIBRE").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros2()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros2()

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Filtrar3()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio 101 ALOCADO con E menos EG04 y EG06 (no sale, no encuentro como quitar los EG04 y EG06)

Selection.AutoFilter Field:=7, Criteria1:="101"

Selection.AutoFilter Field:=9, Criteria1:="E"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("101 ALOCADO").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros3()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros3()

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Filtrar4()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio 102 ALOCADO

Selection.AutoFilter Field:=7, Criteria1:="102"

Selection.AutoFilter Field:=9, Criteria1:="E"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("102 ALOCADO").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros4()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros4()

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Filtrar5()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio RET

Selection.AutoFilter Field:=7, Criteria1:="651"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("RET").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros5()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros5()

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Filtrar6()

'hace que no se visualice la ejecución de la macro

Application.ScreenUpdating = False

' establece el filtro automático

Sheets("Sheet1").Select

Range("A1").Select

Selection.AutoFilter

' establece el criterio EC01

Selection.AutoFilter Field:=7, Criteria1:="501"

' ejecuta el procedimiento donde se copian los registros

' seleccionados

CopiarRegistros

Sheets("EC01").Select

' ejecuta el procedimiento donde se pegan los registros

' seleccionados

PegarRegistros

Sheets("Sheet1").Select

Selection.EntireColumn.Hidden = False

Range("A1").Select

End Sub

Sub CopiarRegistros6()

Range("A:A").Select

Selection.CurrentRegion.Select

Selection.Copy

End Sub

' se pegan los datos

Sub PegarRegistros6()

Range("A1").Select

ActiveSheet.Paste

End Sub

[Armando Montes]

Hola Jose, bienvenido al foro.

Aprovecharas mejor el foro y recibiras major atencion siguiendo las normas del foro, estan en la parte superior de cada pagina.

[José Antonio García Sanz]

Hola Armando, muchas gracias por la bienvenida y recomendaciones.

He leído las normas del foro, gracias por la advertencia.

Sobre el tema que he publicado, no tengo claro si es necesario relaizar alguna modificación, o según está puedo obtener ayuda/solución. Podrías, por favor, indicarme si he de proceder de alguna forma.

Muchas gracias y Saludos

José A.

[Armando Montes]

Hola Jose, basta con que subas tu libro -codigo incluido- mostrando antes y despues.