Macro VBA para copiar varias pestañas filtradas en otros excel

Tengo la siguiente macro en un fichero, que toma filtra por la columna C y por cada valor que hay me lo copia y pega en otro fichero excel y lo guarda como en nombre del texto de la columan C más fichero 1.

Necesito que se repita la misma operación por cada pestaña que tengo en el fichero: consumos, laboratorio y financiación, puede darse el caso de que el valor de la columna C de la pestaña reporte no este en alguna de las otras.

Si además ya en vez de guardarlo en excel guarda todas las hojas del nuevo libro en PDF ajustando el area de impresión sería genial!.

Sub Parrillas_1()

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.StatusBar = False

Set l1 = ThisWorkbook

Set h1 = Sheets("Reporte")

Set h2 = Sheets("temp")

col = "c"

ucol = "u"

n = Columns(col).Column

h2.Cells.Clear

If h1.AutoFilterMode Then h1.AutoFilterMode = False

h1.Columns(col).Copy h2.[A1]

u2 = h2.Range("A" & Rows.Count).End(xlUp).Row

h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes

'

ruta = l1.Path & "\"

u2 = h2.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To u2

Application.StatusBar = "Generando archivo " & i - 1 & " de " & u2 - 1

clave = h2.Cells(i, "A")

If h1.AutoFilterMode Then h1.AutoFilterMode = False

u1 = h1.Range("A" & Rows.Count).End(xlUp).Row

h1.Range("A1:" & ucol & u1).AutoFilter Field:=n, Criteria1:=clave

Set l2 = Workbooks.Add

Set h21 = l2.Sheets(1)

h1.Range("A1:" & ucol & u1).Copy h21.[A1]

h21.Cells.Select

ActiveWindow.DisplayGridlines = False

h21.Cells.Select

h21.Cells.EntireColumn.AutoFit

Selection.AutoFilter

h21.Range("B2").Select

ActiveWindow.FreezePanes = True

h21.Range("A1").Select

l2.SaveAs ruta & clave & "-Fichero1"

l2.Close

Next

If h1.AutoFilterMode Then h1.AutoFilterMode = False

Application.StatusBar = False

MsgBox "Finalizado"

End Sub

Añade tu respuesta

Haz clic para o