Debieras escribir aquí la macro para ver si realmente el problema es el filtro u otras instrucciones...
Anexo Código If UCase(Range("A18").Value) = "X" Then MsgBox ("Seleccione el Mes"), , "Aviso" If UCase(Range("A18").Value) = "X" Then Exit Sub If UCase(Range("A20").Value) = "X" Then MsgBox ("No Existen Datos"), , "Aviso" If UCase(Range("A20").Value) = "X" Then Exit Sub Call Desprotege Sheets("IngresaDatos").Visible = True Sheets("HorasXPersonal").Visible = True Sheets("HorasXPersonal").Select Range("A3:O20003").Select Selection.ClearContents Range("A3").Select Sheets("IngresaDatos").Select Range("H41:AB20042").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _ :=Range("H38:H39"), Unique:=False Range("L42:Z20042").Select Selection.Copy Sheets("HorasXPersonal").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A2").Select Sheets("IngresaDatos").Select Range("H41:AB41").Select Selection.AutoFilter Selection.AutoFilter ActiveWindow.SmallScroll Down:=21 ActiveWindow.SmallScroll Down:=-42 Range("K2").Select Sheets("HorasXPersonal").Select ActiveSheet.PivotTables("HorasPersonal").PivotCache.Refresh Sheets("IngresaDatos").Visible = False Sheets("Principal").Visible = False Call Protege
El código salvo pequeños detalles que dejo a continuación, está perfecto. Si luego igual se demora ya tiene que ver con la cantidad de datos y la capacidad de tu procesador para realizar cálculos. Te escribo la rutina como yo la dejaría Sub filtrando() (ver*) If UCase(Range("A18").Value) = "X" Then MsgBox ("Seleccione el Mes"), , "Aviso": Exit Sub 'If UCase(Range("A18").Value) = "X" Then Exit Sub If UCase(Range("A20").Value) = "X" Then MsgBox ("No Existen Datos"), , "Aviso": Exit Sub 'If UCase(Range("A20").Value) = "X" Then Exit Sub Call Desprotege 'colocar línea de desprotección (**) Sheets("IngresaDatos").Visible = True Sheets("HorasXPersonal").Visible = True Sheets("HorasXPersonal").Select Range("A3:O20003").Select Selection.ClearContents Range("A3").Select Sheets("IngresaDatos").Select Application.Calculation = xlManual 'opcional (***) Range("H41:AB20042").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _ :=Range("H38:H39"), Unique:=False 'copiar solo hasta la última celda con datos (****) ulti = Range("L65536").End(xlUp).Row Range("L42:Z" & ulti).Select Selection.Copy Sheets("HorasXPersonal").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A2").Select Sheets("IngresaDatos").Select Range("H41:AB41").Select Selection.AutoFilter Selection.AutoFilter Application.Calculation = xlAutomatic 'opcional (***) 'ActiveWindow.SmallScroll Down:=21 'no hace falta mover el scroll, directamente selecciona la celda K2 'ActiveWindow.SmallScroll Down:=-42 Range("K2").Select Sheets("HorasXPersonal").Select ActiveSheet.PivotTables("HorasPersonal").PivotCache.Refresh Sheets("IngresaDatos").Visible = False Sheets("Principal").Visible = False Call Protege 'colocar línea de protección (**) End Sub (*) No es necesario repetir el if, podes realizar las 2 operaciones en 1 solo. (**) Una rutina de desprotección seguramente no tiene 1 de 1 línea... entonces para que llamar a otra subrutina si podes colocar esa línea directamente aquí. Lo mismo para la protección (***) Probá de colocar el cálculo en manual y observá el tiempo insumido de un modo u otro. (****) Para que copiar y pegar hasta la fila 20.000 si quizás solo tengas datos hasta la 500, mejor establecé la última celda considerando la col que no tendrá espacios en blanco, por ahora quedó la col L Espero te sirvan las ideas.