Filtrar, copiar y pegar masivo de datos en otro libro

2 envíos / 0 nuevos
Último envío
emoreno
Imagen de emoreno
Offline
última acción: Hace 9 meses 2 días
alta: 01/03/2018 - 23:17
Puntos: 25
Filtrar, copiar y pegar masivo de datos en otro libro

Buenas,

 

Tengo un libro en excel con 3 hojas, en las cuales quiero hacer un filtro (por ejemplo: 600-004), copiar el resultado del filtro y pegarlo en un archivo excel a modo de plantilla en blanco con las pestañas ya creadas y una grafica en una de ellas que toma los datos de los datos que se pegan

 

Para que os hagais una idea el codigo que tengo escrito ahora mismo es el siguiente:

 

 

 

Sub macro()

 

 

    Workbooks.Open "C:\Users\root\Documentos\informes\plantilla.xlsx"

    Windows("macro.xlsm").Activate

    Sheets("Tarjetas").Select

    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

    Range("A1").Select

    ActiveSheet.Range("$A$1:$T$10000").AutoFilter Field:=20, Criteria1:="=600-004*"

    ActiveSheet.AutoFilter.Range.Copy

    Windows("plantilla.xlsx").Activate

    Sheets("Tarjetas de combustible").Select

    ActiveSheet.Paste

    

    Windows("macro.xlsm").Activate

    Sheets("Flota").Select

    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

    Range("E1").Select

    ActiveSheet.Range("$A$1:$E$10000").AutoFilter Field:=5, Criteria1:="=600-004*"

    ActiveSheet.AutoFilter.Range.Copy

    Windows("plantilla.xlsx").Activate

    Sheets("Estado de flota").Select

    ActiveSheet.Paste

    Cells.EntireColumn.AutoFit

    

    Windows("macro.xlsm").Activate

    Sheets("Indebidos").Select

    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

    Range("O1").Select

    ActiveSheet.Range("$A$1:$Q$10000").AutoFilter Field:=16, Criteria1:="=600-004*"

    ActiveSheet.AutoFilter.Range.Copy

    Windows("plantilla.xlsx").Activate

    Sheets("Consumos indebidos").Select

    ActiveSheet.Paste

    Cells.EntireColumn.AutoFit

    ActiveWorkbook.SaveAs Filename:="C:\Users\user\Documentos\informes\600-004.xls"

 

End Sub

 

 

Esto me funciona perfecto, pero en la realidad tengo que hacer esto con casi 400 codigos tipo:

600-004

600-004-900

640-430-820

 

Habria alguna forma mediante VBA de recoger todos esos codigos que estan en la columna T e ir filtrandolo uno por uno para que filtre sin repetir busqueda y guarde con el mismo valor como hace esta macro?

 

Espero haberme explicado bien, sino me dicen...

Adjunto captura

Gracias de antemano

AdjuntoTamaño
Image icon cap.jpg286.37 KB
pacomegia
Imagen de pacomegia
Offline
última acción: Hace 5 horas 54 mins
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntosNivel 5 - 4000 puntosadministrador
alta: 27/12/2006 - 23:26
Puntos: 9690
se trataría de realizar un

se trataría de realizar un bucle que llamase a tu macro.

para ello necesitas varias cosas para preparar tu macro actual.

Lo primero que necesitas es una lista de códigos únicos a partir de lo que haya en la columan T. Eso lo puedes conseguir con un FiltroAvanzado, con la opción de copiar a otro lugar y la opción de sólo registros únicos.

por ejemplo, algo parecido a esto:

Range("T:T").AdvancedFilter xlFilterCopy, , rangodestino, True

tu bucle consistiría en recorrer todas las celdas de tu rango de destino

Dim miCelda as Range

For Each miCelda in rangodestino

 ... aquí iría todo el proceso con cada valor del filtro

 ... el valor del filtro en cada iteración del bucle es miCelda.Value

Next

 

No toda tu macro irá dentro dle bucle, las primeras instrucciones de tu procedimiento son para abrir el archivo, ir a la hoja, quitar el filtro previo si lo hay, etc.  eso sólo habría que realizarlo una vez, antes del bucle.

Luego viene la instrucción que aplica el filtro y los pasos de copiar los datos, al otro libro, etc. Eso es lo que tiene que ir dentro del bucle.

tendrás que adaptar las referencias a la variable del bucle.

por ejemplo, esta línea  

ActiveSheet.Range("$A$1:$T$10000").AutoFilter Field:=20, Criteria1:="=600-004*"

la tienes que poner de este modo 
ActiveSheet.Range("$A$1:$T$10000").AutoFilter Field:=20, Criteria1:=miCelda.Value

lo mismo tendrás que hacer con el resto de cosas que utilicen el valor del filtro, como el nombre que le pones al archivo, etc.

 

Data Tools Suite
datos y tablas con Excel