Antoni

Yo le he dado otro enfoque. Despuès de mostrar el formulario, haz click en el primer elemento a respetar, y sin soltar, arrastra hasta el último que quieras y pulsa el botón ELIMINAR NO SELECCIONADOS. Eliminar items de Listbox Antoni.xlsm

Es evidente que lo que describes no tiene nada que ver con la realidad. Sube tu archivo y veremos el porqué de la lentitud.

Revisa ambas opciones: Sub Calcola_Teriodo_Trascorso1() With Foglio1 .Range("H11").Value = .Range("H1").Value .Range("H11").Formula = "=G11-$H$1" .Range("I11").Formula = "=IF(G11="""","""",IF(TODAY()>G11,""Scaduta"",IF(TODAY()+15>G11,""In scadenza"",""Valida"")))" End With End Sub Sub Calcola_Teriodo_Trascorso2() With Foglio1 .Range("H11").Value = .Range("H1").Value .Range("H11").Formula = "=G11-$H$1" .Range("I11").FormulaLocal = "=SE(G11="""";"""";SE(OGGI()>G11;""Scaduta"";SE(OGGI()+15>G11;""In scadenza"";""Valida"")))" End With End Sub

Sub BorrarColumnas() With ActiveSheet celda = Application.InputBox("Selecciona la celda que contiene el valor a buscar en la fila 10", , , 8) Set valor = .Rows(10).Find(celda, , , xlWhole, , 2) maxcol = .Cells(10, Columns.Count).End(xlToLeft).Column .Range(.Columns(valor.Column), .Columns(maxcol)).Clear End With End Sub

Inténtalo así:

.

Y además, debes eliminar la fila antes de volver a proteger la hoja, porqué de lo contrario, no te funcionará.

A ver si lo consigues tu solo: Sigue estos pasos y te debería funcionar 1) Define una variable a nivel userform, por ejemplo: Dim Filah As Long 2) Guarda la fila después de buscar la operación, así: FilaH = Activecell.Row 3) En el momento de aplicar la anulación: Sheets("HISTÓRICO").Rows(FilaH).Delete

Sin tu archivo, es imposible.

Yo si he podido descargar tu archivo, pero 10 Mbytes es un tamaño de archivo inmanejable. Tu hoja HISTÓRICO contiene más de 1.000.000 de filas vacías y otras hojas, aunque en menor medida, también contienen una gran cantidad de filas innecesarias. Construye un archivo solo con las hojas y datos necesarios para probar tu ejemplo y vuélvelo a subir.

¿Y cual es el formulario? Porqué en tu archivo hay muchos.

En un alarde de imaginación he supuesto que lo que realmente quieres es esto. Scroll horizontal con Multipage.xlsm

Esto parece que funciona con cualquier navegador. Modifica los tiempos de retraso si es necesario. Sub EnviaWhatsapp() Application.ScreenUpdating = False Application.DisplayAlerts = False telwhatsapp = "34666666666" 'Código de país seguido del número de teléfono textwhatsapp = "Enviado desde Excel" If telwhatsapp = Empty Or textwhatsapp = Empty Then MsgBox ("Debe ingresar número de telefono y texto para enviar Whatsapp"), vbCritical, "AVISO" Exit Sub End If mylinkwhatsapp = "https://api.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp ActiveWorkbook.FollowHyperlink mylinkwhatsapp Application.Wait (Now + TimeValue("00:00:01")) ActiveWindow.Application.SendKeys "{TAB}" Application.Wait (Now + TimeValue("00:00:01")) ActiveWindow.Application.SendKeys "{TAB}" Application.Wait (Now + TimeValue("00:00:01")) ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje Application.Wait (Now + TimeValue("00:00:01")) ActiveWindow.Application.SendKeys "(~)" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub

Sube un archivo Excel con datos para poder probar poniendo un ejemplo de lo que quieres obtener.

Abre el adjunto y pulsa sobre la flecha azul. Ejemplo (3).xlsm