Problema con copiar rango autofiltro

[Pirtrafilla]

Hola a todos de nuevo.

Tengo un problema con un autofiltro. Necesito filtrar 3 columnas, de "F" a "K" y el criterio se encuentra en la columna "K" que es la columna 3 del criterio.

Lo que necesito es copiar los datos filtrados pero solo de las dos primeras columnas, no las 3 columnas, y llevármelas a otra hoja. Por ahora lo que consigo es llevarme las 3 columnas y no se llevarme solo las 2 columnas primeras del autofiltro.

Este es el código que tengo.

Sub ExportarTecnicos()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
'
Dim wsPxA As Worksheet, wsGrupos As Worksheet
Dim rngData As Range
Set wsPxA = Sheets("PxA"): Set wsGrupos = Sheets("Grupos")
NumRows = wsGrupos.Range("F65536").End(xlUp).Row       'final de fila de nombre de grupos y encargados
c = 1                                                  'primera columna de nombre de grupos
For x = 3 To NumRows                                   'recorremos todas las filas de nombres de grupos
wsPxA.Cells(4, c) = wsGrupos.Cells(x, 6)               'copiamos el nombre de grupo
wsPxA.Cells(4, c + 2) = wsGrupos.Cells(x, 7)           'copiamos el encargado
cr1 = wsGrupos.Cells(x, 6)                             'zona a filtrar
wsGrupos.Range("I2:K2").Select                         'seleccionamos donde hacer autofiltro
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=cr1 ', Operator:=xlAnd 'filtramos
Set rngData = wsGrupos.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
     rngData.Select
     Selection.Copy
     wsPxA.Cells(7, c).PasteSpecial
     Selection.AutoFilter
c = c + 6                                              'siguiente columna con nombre de grupo
Next x
'
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.CutCopyMode = False
End Sub

Agradezco vuestra ayuda.

Moisés.

 

[Leopoldo Blancas]

Hace 23 minutos , Pirtrafilla dijo:

rngData.Select

Tu error, creo yo, es que seleccionas toda la Data que filtras, tienes que hacer un rango sinamico de las 2 columnas.

Y SIN ARCHIVO... NO PUEDO DECIR MAS.

Saludos.

[Pirtrafilla]

Hola, adjunto un archivo de ejemplo, con pocos datos.

Gracias!!

 

Prueba.xlsm

[Leopoldo Blancas]

Hola @Pirtrafilla,

Eres los de Copy->Paste...??? = Con lo que me den y si jala bien y  pido ya otra cosa...

Te voy a dar los tips, ya que como veo en tu código que ya usas:

1. Set
2. SpecialCells(xlCellTypeVisible)
3. AutoFilter

Creo que no tendrás problemas de armar esto:

1. Crea un rango al iniciar que tome en cuenta la columna "I" y "J" de todos los registros de la hoja Grupos
2. Después de filtrar que te seleccione solo los visibles.

SON 3 LINEAS DE CÓDIGO QUE FALTAN, SUSTITUYENDO UNA DE ELLAS.

Y ESO QUE FALTA ES MAS BÁSICO QUE LOS FILTERS.

Saludos.

 

[Pirtrafilla]

@Leopoldo Blancas, ¿te refieres a esto?

Dim wsPxA As Worksheet, wsGrupos As Worksheet
Dim rngData As Range
Set wsPxA = Sheets("PxA"): Set wsGrupos = Sheets("Grupos")
wsGrupos.Activate
NumRows = wsGrupos.Range("F65536").End(xlUp).Row       'final de fila de nombre de grupos y encargados
c = 1                                                  'primera columna de nombre de grupos
For x = 3 To NumRows                                   'recorremos todas las filas de nombres de grupos
wsPxA.Cells(4, c) = wsGrupos.Cells(x, 6)               'copiamos el nombre de grupo
wsPxA.Cells(4, c + 2) = wsGrupos.Cells(x, 7)           'copiamos el encargado
cr1 = wsGrupos.Cells(x, 6)                             'zona a filtrar
wsGrupos.Range("I2:K2").Select                         'seleccionamos donde hacer autofiltro
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=cr1
Set rngData = wsGrupos.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
     NumRows2 = wsGrupos.Range("I65536").End(xlUp).Row
     wsGrupos.Range("I2:J" & NumRows2).Select
     Selection.Copy
     wsPxA.Cells(7, c).PasteSpecial
     Selection.AutoFilter
c = c + 6                                              'siguiente columna con nombre de grupo
Next x

He añadido estas:

NumRows2 = wsGrupos.Range("I65536").End(xlUp).Row
wsGrupos.Range("I2:J" & NumRows2).Select

Y eliminado esta otra:

rngData.Select

Ahora funciona!!!!

Muchas gracias.

 

[Pirtrafilla]

Hace 28 minutos , Leopoldo Blancas dijo:

Eres los de Copy->Paste...??? = Con lo que me den y si jala bien y  pido ya otra cosa...

¿A que te refieres con esto? No te entiendo.