Buen día expertos: Tengo un problema con una macro que me realiza un autofiltro de una hoja y copia y pega los valores en otras hojas distintas. Hasta ahi todo marchaba bien, pero se me ocurrió meterle una función que si dentro de un rango de celdas se encontraba un valor corriera una serie de comandos y ahora mi macro se volvió muy lenta, espero me puedan ayudar. Este es el código que escribí: Sub Filtro() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False Sheets("Hoja 1").Select Range("A12").Select Selection.AutoFilter For a = 13 To Range("D" & Rows.Count).End(xlUp).Row If Cells(a, "D") = "220" Then Selection.AutoFilter Field:=4, Criteria1:="220" Sheets("Hoja 1").Select Range("b13:c412").Copy Sheets("220").Range("b13:C412").PasteSpecial Paste:=xlValues Range("E13:G412").Copy Sheets("220").Range("D13:F412").PasteSpecial Paste:=xlValues Range("H13:H412").Copy Sheets("220").Range("S13:S412").PasteSpecial Paste:=xlValues Range("AR13:AT412").Copy Sheets("220").Range("G13:I412").PasteSpecial Paste:=xlValues Range("AY13:AY412").Copy Sheets("220").Range("J13:J412").PasteSpecial Paste:=xlValues Range("BB13:BB412").Copy Sheets("220").Range("M13:M412").PasteSpecial Paste:=xlValues Range("BC13:BC412").Copy Sheets("220").Range("O13:O412").PasteSpecial Paste:=xlValues Selection.EntireColumn.Hidden = False End If If Cells(a, "D") = "440" Then Selection.AutoFilter Field:=4, Criteria1:="440" Sheets("Hoja 1").Select Range("b13:c412").Copy Sheets("440").Range("b13:C412").PasteSpecial Paste:=xlValues Range("E13:G412").Copy Sheets("440").Range("D13:F412").PasteSpecial Paste:=xlValues Range("H13:H412").Copy Sheets("440").Range("S13:S412").PasteSpecial Paste:=xlValues Range("AR13:AT412").Copy Sheets("440").Range("G13:I412").PasteSpecial Paste:=xlValues Range("AY13:AY412").Copy Sheets("440").Range("J13:J412").PasteSpecial Paste:=xlValues Range("BB13:BB412").Copy Sheets("440").Range("M13:M412").PasteSpecial Paste:=xlValues Range("BC13:BC412").Copy Sheets("440").Range("O13:O412").PasteSpecial Paste:=xlValues Selection.EntireColumn.Hidden = False End If If Cells(a, "D") = "480" Then Selection.AutoFilter Field:=4, Criteria1:="480" Sheets("Hoja 1").Select Range("b13:c412").Copy Sheets("480").Range("b13:C412").PasteSpecial Paste:=xlValues Range("E13:G412").Copy Sheets("480").Range("D13:F412").PasteSpecial Paste:=xlValues Range("H13:H412").Copy Sheets("480").Range("S13:S412").PasteSpecial Paste:=xlValues Range("AR13:AT412").Copy Sheets("480").Range("G13:I412").PasteSpecial Paste:=xlValues Range("AY13:AY412").Copy Sheets("480").Range("J13:J412").PasteSpecial Paste:=xlValues Range("BB13:BB412").Copy Sheets("480").Range("M13:M412").PasteSpecial Paste:=xlValues Range("BC13:BC412").Copy Sheets("480").Range("O13:O412").PasteSpecial Paste:=xlValues Selection.EntireColumn.Hidden = False End If If Cells(a, "D") = "600" Then Selection.AutoFilter Field:=4, Criteria1:="600" Sheets("Hoja 1").Select Range("b13:c412").Copy Sheets("600").Range("b13:C412").PasteSpecial Paste:=xlValues Range("E13:G412").Copy Sheets("600").Range("D13:F412").PasteSpecial Paste:=xlValues Range("H13:H412").Copy Sheets("600").Range("S13:S412").PasteSpecial Paste:=xlValues Range("AR13:AT412").Copy Sheets("600").Range("G13:I412").PasteSpecial Paste:=xlValues Range("AY13:AY412").Copy Sheets("600").Range("J13:J412").PasteSpecial Paste:=xlValues Range("BB13:BB412").Copy Sheets("600").Range("M13:M412").PasteSpecial Paste:=xlValues Range("BC13:BC412").Copy Sheets("600").Range("O13:O412").PasteSpecial Paste:=xlValues Selection.EntireColumn.Hidden = False End If Next ActiveSheet.ShowAllData Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ActiveSheet.DisplayPageBreaks = True Application.CutCopyMode = False End Sub Espero me puedan ayudar en simplificar mi codigo. Saludos y gracias

Bienvenido a la mayor comunidad de usuarios EXCEL

Regístrate gratis ahora para ver contenidos y descargas sin restricciones!

Regístrate gratis Ingresar

JavaScript está desactivado. Para una mejor experiencia, por favor active JavaScript en su navegador antes de continuar.

Ejecutar una macro si se encuentra un valor en un rango

Autor del tema LUIS JUAREZ
Fecha de inicio 3 Oct 2017

LUIS JUAREZ

New member

3 Oct 2017

Buen día expertos:

Tengo un problema con una macro que me realiza un autofiltro de una hoja y copia y pega los valores en otras hojas distintas. Hasta ahi todo marchaba bien, pero se me ocurrió...

Para poder visualizar el resto de este tema y sus adjuntos:
. Si nunca te has registrado puedes registrarte gratis aquí
. Si ya te has registrado debes iniciar sesión aquí

Iniciar sesión o registrarme para responder aquí.

Temas similares

Resuelto

Buscar duplicados y si no los encuentra ejecutar otra macro

Respuestas: 5

15 Feb 2021

Manu Este

Pregunta

al ejecutar la macro parpadea la pantalla

Respuestas: 2

20 Nov 2025

jairorodri

Resuelto

Ayuda con esa macro ejecutar con enter y boton

Respuestas: 3

11 Nov 2025

Miltiño

Pregunta

Ejecutar macro en segundo plano

Respuestas: 1

22 Ene 2025

joselica

Resuelto

1 macro se pueda ejecutar la veces celdas con datos dentro de un rango

Respuestas: 3

21 Oct 2024

mago18

Resuelto

Ejecutar una macro al cambiar el valor de una celda

Respuestas: 10

10 Abr 2025

José González González

Pregunta

Ejecutar un método abreviado con macro

Respuestas: 7

16 Oct 2024

Ferciforce

Pregunta

Ejecutar macro cuando se actualice una tabla dinámica

Respuestas: 4

29 Oct 2025

TodoExcel

Resuelto

Utilizar ExecuteExcel4Macro para ejecutar Workbook_SheetActivate

Respuestas: 4

4 Ago 2024

zelarra

Pregunta

Macro ejecutar

Respuestas: 1

18 Abr 2024

Leopoldo Blancas

Facebook X Bluesky LinkedIn Reddit Pinterest Tumblr WhatsApp Correo electrónico Enlace

Bienvenido a nuestro foro Excel 👋

Tenemos 135.000 usuarios registrados,
y 240.000 preguntas y respuestas Excel.

Primero 👉 regístrate gratis aquí 👈
para ver contenidos y descargas
sin restricciones!

Este sitio usa cookies para ayudar a personalizar el contenido, adaptar su experiencia y mantenerlo conectado si se registra.
Al continuar usando este sitio, usted está consintiendo nuestro uso de cookies.

Aceptar Saber más…

Volver

Arriba