** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Otros de Microsoft: Windows y Office > Excel
  Mensajes nuevos Mensajes nuevos RSS - Filtrar y pegar registros
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoFiltrar y pegar registros

 Responder Responder
Autor
Mensaje
Dany Solis Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 23/Octubre/2010
Localización: Cd. Juarez Méx
Estado: Sin conexión
Puntos: 912
Enlace directo a este mensaje Tema: Filtrar y pegar registros
    Enviado: 31/Agosto/2021 a las 17:05
Hola a todos,

Tengo un problema para aplicar filtros en vba, el problema es el siguiente:

Necesito analizar los datos de un feedback estos los descargo en una tabla Excel, el problema es que en la columna donde evaluan el Depto. los usuarios pueden evaluar con opcion multiple a varios Dept. o a todos con solo contestar una vez la encuesta.

En otra tabla tengo categorizado los Dept. y los grupos por cada grupo necesito crear una hoja con sus respectivos datos, si el usuario evalua un solo Dept. no tengo problemas aplico el filtro con vba y me lo llevo a la hoja correspondiente, pero si evalua mas de un Dept. perteneciente a diferente grupo o todos los Depto. no he encontrado la forma de filtrar los datos y llevarlo a su hoja correspondiente.

Describo las tablas que tengo:

Depto, nombres de los Dept evaluados
Grupo, nombre del grupo al que pertenecen y nombre de la hoja al que deben de ser ingresados los datos recabados.

No
Depto
Grupo
1
Ing. Industrial
Ing. Sistemas
2
Sistemas
Ing. Sistemas
3
Bases de Datos
Ing. Sistemas
4
Equipos Automaticos
Ing. De Equipo
5
Equipos Semi-Automaticos
Ing. De Equipo
6
Kits
Ing. De Equipo
7
Dados
Proceso
8
Terminales
Proceso
9
Sellos
Provedor
10
Todas las anteriores
Todos

Ejemplo de la tabla con los datos recabados:

ID

Hora de inicio

Hora de finalización

Correo electrónico

¿ De cuál de las siguientes áreas requieres mas servicios?

96

44383.64594

44383.64772

anonymous

Equipos Automaticos

97

44384.47806

44384.47925

anonymous

Equipos Automaticos

98

44384.47777

44384.47954

anonymous

Equipos Automaticos

99

44384.47978

44384.48068

anonymous

Bases de Datos

100

44386.28764

44386.29155

anonymous

Sistemas

101

44386.37815

44386.37988

anonymous

Todas las anteriores

102

44386.39321

44386.39418

anonymous

Equipos Automaticos;KITS;Dados;Ingenieria Industrial;

103

44386.39481

44386.39554

anonymous

Sistemas;Bases de Datos;Ingenieria Industrial;

104

44386.57405

44386.57652

anonymous

Dados;Equipos Automaticos;

105

44386.61575

44386.61701

anonymous

Ingenieria Industrial;

106

44389.3222

44389.32315

anonymous

Bases de Datos;Equipos Automaticos;

107

44389.35726

44389.36476

anonymous

Dados;

108

44390.40284

44390.40453

anonymous

Dados;Equipos Automaticos;KITS;


Este es el Macro que tengo:

' Agrupa los datos y lo agrega a  su respectiva hoja
'

'
' Grupo 1 de Ing. Sistemas

    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Selection.AutoFilter
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=5, _
    Criteria1:=Array("Ing. Industrial", "Bases de datos", "Sistemas"), _
    Operator:=xlFilterValues

    Range("Table1[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Ing. Sistemas").Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    
'Grupo 2 Ing. De Equipo

    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Selection.AutoFilter
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=5, _
    Criteria1:=Array("Equipos Automaticos", "Equipos Semi-Automaticos", "KITS"), _
    Operator:=xlFilterValues

    Range("Table1[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Ing. De Equipo").Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    
    
    'Proceso

    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Selection.AutoFilter
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=5, _
    Criteria1:=Array("Dados", "Terminales"), _
    Operator:=xlFilterValues

    Range("Table1[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Proceso").Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Sheets("Data").Select
    Range("Table1[[#Headers],[ID]]").Select
    Application.CutCopyMode = False
    Selection.AutoFilter

Alguna idea para solucionar el problema, se me ocurre meter las diferentes tipos de variantes que pudieran existir pero no se si sea lo mas correcto.

Espero me puedan auidar.

Saludos

DS
Donde hay educación, no hay distinction de clases. (Confusio)

Dany Solis
Arriba
AnSanVal Ver desplegable
Administrador
Administrador
Avatar

Unido: 16/Marzo/2005
Localización: España
Estado: Sin conexión
Puntos: 5970
Enlace directo a este mensaje Enviado: 31/Agosto/2021 a las 18:31

Hola Dany.


1.- No niego que muchas veces la grabadora de macros ayuda, pero luego es necesario depurar el código resultante, optimizándolo y quitando lo que no es necesario.

2.- La mayoría de las veces es más eficiente realizar las tareas sin seleccionar rangos.

3.- Las tablas que dices poseer no parecen tener relación con el código VBA que expones, en este filtras por el campo 5 y ninguna de las tablas que compartes tiene tantos campos. Ouch

Tu explicación deja bastantes «sombras» en el camino y no soy capaz de entender lo que tienes y lo que pretendes hacer.


Saludos desde Tenerife.
Arriba
Dany Solis Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 23/Octubre/2010
Localización: Cd. Juarez Méx
Estado: Sin conexión
Puntos: 912
Enlace directo a este mensaje Enviado: 31/Agosto/2021 a las 21:25
Peron Antonio, tienes razon limite la tabla de datos  a solo 5 entonces comparto los detalles:

Hoja Data en realidad tiene 12, en la columna 5 (E) estan alojados los datos que filtro en la macro.
La hoja Grupos es meramente demostrativa para mostrar a que grupo pertenece cada Dept.
Si el el usuario evaluo todas las anteriores, entonces agregar por cada respuesta (Todas las anteriores)
a cada hoja.

Hoja Origen:
La hola que contiene todos los datos es Data dentro la Table1. 

Hojas Destino:
Ing. Sistemas
Ing. de Equipo
Proceso
Provedor

Comparto un ejemplo en mi Dirve para ser mas explicito, en lo que busco al final.


Saludos

DS
Donde hay educación, no hay distinction de clases. (Confusio)

Dany Solis
Arriba
Dany Solis Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 23/Octubre/2010
Localización: Cd. Juarez Méx
Estado: Sin conexión
Puntos: 912
Enlace directo a este mensaje Enviado: 02/Septiembre/2021 a las 05:11
Usando la grabadora de Macros este codigo me esta funcionando bien, aunque quizas no sea lo mejor, y halla mejores opciones, pero bueno despues de hacer el primer filtro y pegado a la hoja "Ing. Sistemas" como me puedo posicionar en la siguiente fila vacia y pegar los datos del siguiente filtro?

Este es el codigo generado:

Sub Filter()

'Grupo Ing. Sistemas

'*****************************************************************************************************'
'Ing. Industrial
'*****************************************************************************************************'

    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Ing. Industrial*" _
        , Operator:=xlAnd
        Sheets("Ing. Sistemas").UsedRange.ClearContents
    Sheets("Data").UsedRange.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Ing. Sistemas").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData


'*****************************************************************************************************'
'Sistemas
'*****************************************************************************************************'

'Posicionarme en la ultima fila vacia y pegar los datos del segundo filtro?

    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Sistemas*" _
        , Operator:=xlAnd
    Sheets("Data").UsedRange.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Ing. Sistemas").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData
    
 
'*****************************************************************************************************'
'Base de Datos
'*****************************************************************************************************'
   
    Sheets("Data").Select
Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Bases de Datos*" _
        , Operator:=xlAnd
    Sheets("Data").UsedRange.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Ing. Sistemas").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData
    
       
'*****************************************************************************************************'
'Todas las anteriores
'*****************************************************************************************************'

 
    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Todas las anteriores*" _
        , Operator:=xlAnd
    Sheets("Data").UsedRange.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Ing. Sistemas").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Data").Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData
    
    
End Sub


Saludos

DS

Donde hay educación, no hay distinction de clases. (Confusio)

Dany Solis
Arriba
Dany Solis Ver desplegable
Colaborador
Colaborador
Avatar

Unido: 23/Octubre/2010
Localización: Cd. Juarez Méx
Estado: Sin conexión
Puntos: 912
Enlace directo a este mensaje Enviado: 18/Septiembre/2021 a las 07:35
Aqui la solución de mi problema:

Filtro todos cada Dept. para posterior pegar los datos en la hoja de su grupo correspondiente:

Sub Filter()

    ' ----------------------------------------------------------------
    'Grupo Ing Industrial
    ' ----------------------------------------------------------------

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Sheets("Data")

    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Ing. Industrial*" _
        , Operator:=xlAnd
    Sheets("Ing. Industrial").UsedRange.ClearContents
    Sheets("Data").UsedRange.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Sistemas").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData


    ' ----------------------------------------------------------------
    'Grupo Sistemas
    ' ----------------------------------------------------------------

    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Sistemas*" _
        , Operator:=xlAnd
    Range("A2").CurrentRegion.Offset(1, 0).Resize(Range("A2").CurrentRegion.Rows.Count - 1).Copy
    Sheets("Sistemas").Select
    Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Range("A1").Select
    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData


    ' ----------------------------------------------------------------
    'Grupo Bases de datos
    ' ----------------------------------------------------------------

    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*Bases de Datos*" _
        , Operator:=xlAnd
    Range("A2").CurrentRegion.Offset(1, 0).Resize(Range("A2").CurrentRegion.Rows.Count - 1).Copy
    Sheets("Sistemas").Select
    Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Range("A1").Select
    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData


    ' ----------------------------------------------------------------
    'Todas las Anteriores
    ' ----------------------------------------------------------------

    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter Field:=5, Criteria1:="*All*" _
        , Operator:=xlAnd
    Range("A2").CurrentRegion.Offset(1, 0).Resize(Range("A2").CurrentRegion.Rows.Count - 1).Copy
    Sheets("Sistemas").Select
    Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Range("A1").Select
    ws.Select
    Range("Datos[[#Headers],[ID]]").Select
    ActiveSheet.ListObjects("Datos").AutoFilter.ShowAllData

End Sub

Pueden cerrar el hilo por favor.

DS
Donde hay educación, no hay distinction de clases. (Confusio)

Dany Solis
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable