Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Application.ScreenUpdating no me funciona

Excel - Application.ScreenUpdating no me funciona

Volver
Nuevo Tema
<<>>
 
Vista:

Application.ScreenUpdating no me funciona

Publicado por Jonathan Fuentes HN (1 intervención) el 07/06/2022 18:27:44
Buenos días, esperando que estén bien.

Mi problema es el siguiente: Estoy detallando una macro que copia datos de un libro a otro, me funciona bien, pero necesito que no se muestren los parpadeos al ejecutarse. Integré en la primera línea de la misma el Application.ScreenUpdating pero no me funciona, siempre están los parpadeos.

Les dejo mi macro:
Sub ImportarDatosLP()
Application.ScreenUpdating = False
'Macro para poder importar los datos desde la hoja consolidada de resultados

Dim wbLibroOrigen As Workbook
Dim wsHojaOrigen As Worksheet

Dim wbLibrodestino As Workbook
Dim wsHojadestino As Worksheet

Dim ruta As String

ruta = "\\URLURLURLURLURLURL.xlsm"

'Datos destino
Set wbLibrodestino = Workbooks(ThisWorkbook.Name)
Set wsHojadestino = wbLibrodestino.Worksheets("Ingreso de datos LYP")

'Datos Origen
Set wbLibroOrigen = Workbooks.Open(ruta)

''Mostrar hojas


For Each N In Sheets

N.Visible = True

Next N


Set wsHojaOrigen = wbLibroOrigen.Worksheets("Consolidado LyP")

'Proyectos de mejora - Gráfico 1
wsHojaOrigen.Range("c6:q6").Copy
wsHojadestino.Range("c7").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

'MEDICION 1
wsHojaOrigen.Range("c13:g27").Copy
wsHojadestino.Range("c12").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

'Generación de reportes - gráfico 2
wsHojaOrigen.Range("d33:r33").Copy
wsHojadestino.Range("d32").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

'MEDICION 2
wsHojaOrigen.Range("c39:g53").Copy
wsHojadestino.Range("c38").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

'MEDICION 3
wsHojaOrigen.Range("c57:g71").Copy
wsHojadestino.Range("c56").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

Workbooks(wbLibroOrigen.Name).Close savechanges:=False

Application.ScreenUpdating = True

End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Application.ScreenUpdating no me funciona

Publicado por Antoni Masana (2540 intervenciones) el 10/06/2022 18:48:20
A mi tambien me pasaba y lo solucione poniendo el ScreenUpdate después de abrir y cerrar.

He añadido una línea en negrita:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub ImportarDatosLP()
    Application.ScreenUpdating = False
 
    ' ---&--- Macro para poder importar los datos desde la hoja consolidada de resultados
 
    Dim wbLibroOrigen As Workbook, wsHojaOrigen As Worksheet
    Dim wbLibrodestino As Workbook, wsHojadestino As Worksheet
    Dim ruta As String
 
    ruta = "\\URLURLURLURLURLURL.xlsm"
 
    ' ---&--- Datos destino
    Set wbLibrodestino = Workbooks(ThisWorkbook.Name)
    Set wsHojadestino = wbLibrodestino.Worksheets("Ingreso de datos LYP")
 
    ' ---&--- Datos Origen
    Set wbLibroOrigen = Workbooks.Open(ruta)
    Application.ScreenUpdating = False
 
    ' ---&--- ' ---&--- Mostrar hojas
    For Each N In Sheets
        N.Visible = True
    Next N
 
    Set wsHojaOrigen = wbLibroOrigen.Worksheets("Consolidado LyP")
 
    ' ---&--- Proyectos de mejora - Gráfico 1
    wsHojaOrigen.Range("c6:q6").Copy
    wsHojadestino.Range("c7").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
 
    ' ---&--- MEDICION 1
    wsHojaOrigen.Range("c13:g27").Copy
    wsHojadestino.Range("c12").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
 
    ' ---&--- Generación de reportes - gráfico 2
    wsHojaOrigen.Range("d33:r33").Copy
    wsHojadestino.Range("d32").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
 
    ' ---&--- MEDICION 2
    wsHojaOrigen.Range("c39:g53").Copy
    wsHojadestino.Range("c38").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
 
    ' ---&--- MEDICION 3
    wsHojaOrigen.Range("c57:g71").Copy
    wsHojadestino.Range("c56").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
 
    Workbooks(wbLibroOrigen.Name).Close savechanges:=False
 
    Application.ScreenUpdating = True
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Nolberto
Val: 84
Ha aumentado su posición en 6 puestos en Excel (en relación al último mes)
Gráfica de Excel

Application.ScreenUpdating no me funciona

Publicado por Nolberto (128 intervenciones) el 11/06/2022 23:06:53
Hay varias cosas que puedes hacer para el parpadeo pero tambien respecto al rendimiento, lo básico serian estos 2 puntos.

1.- Puedes crear una instancia de excel para abrir el otro archivo, pero que este no sea visible.
2.- No uses Copy para obtener los datos, por ende tampoco PasteSpecial, en su lugar puedes pasar los datos de origen a memoria con .Value y luego pasarlos al rango destino, esto mejora la velocidad, se nota sobre todo cuando son muchos datos.

El punto 1 es un paso adicional al tener que generar otra instancia de excel, lo cual significa tiempo, pero eso se puede recuperar al no usar copy y pastespecial.

Este código de ejemplo te puede servir.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
 
Sub test()
    Dim excelApp As Excel.Application
    Dim libroOrigen As Workbook
    Dim hojaOrigen As Worksheet
    Dim libroDestino As Workbook
    Dim hojaDestino As Worksheet
    Dim rutaOrigen As String
    Dim dataOrigen1() As Variant, dataOrigen2() As Variant
 
    Application.ScreenUpdating = False
 
    rutaOrigen = "C:\Users\Test\Desktop\test1.xlsx"
    Set excelApp = New Excel.Application
    excelApp.Visible = False
    Set libroOrigen = excelApp.Workbooks.Open(rutaOrigen)
    Set hojaOrigen = libroOrigen.Worksheets("Hoja1")
 
    Set libroDestino = Workbooks(ThisWorkbook.Name)
    Set hojaDestino = libroDestino.Worksheets("Hoja1")
 
    dataOrigen1 = hojaOrigen.Range("A2:C4").Value
    hojaDestino.Range("A2:C4").Value = dataOrigen1
 
    dataOrigen2 = hojaOrigen.Range("F2:H4").Value
    hojaDestino.Range("F2:H4").Value = dataOrigen2
 
    libroOrigen.Close SaveChanges:=False
    excelApp.Quit
    Set excelApp = Nothing
 
    Application.ScreenUpdating = True
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar