Macro para cambiar información en un "Tablero dinámico".
Hola Expertos, bueno días.
Tengo en una hoja de excel, varios cuadros como este (imagen), lo que deseo hacer, en una hoja dejar un tablero y que mediante una macro, cada 15 segundos, vaya rotando la información que que estan contenidas en los cuadritos de otra hoja. Que la macro, copie los datos de todos y cada uno de los cuadritos a ese tablero, sin borrar el origen, pero si reemplazando la existente en el tablero, siempre siguiendo un orden.
Esto es para mostrarlo en un monitor.
1 Respuesta
Puedes enviarme tu archivo con las hojas y los cuadros, para revisar en dónde están.
Me dices cuál es el orden de copiado.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Luis Carlos” y el título de esta pregunta.
Dante, ya te he enviado el archivo al correo que me indicaste.
Gracias.
Dante, recibiste el archivo?. POdrías confirmarme por favor.
Muchas gracias..!
Luis Carlos
Luis Carlos:
Te confirmo la recepción del documento, dame oportunidad de revisarlo y te envío la respuesta.
¡Gracias!, tranquilo. Muy amable.
Estas son las macros
Sub unacopia()
'Por.Dante Amor
Application.ScreenUpdating = False
CopiarTablero
Application.ScreenUpdating = True
End Sub
Sub variascopias()
'Por.Dante Amor
Application.ScreenUpdating = False
Sheets("Tablero").[Z2] = ""
Repetir
Application.ScreenUpdating = True
End Sub
Sub Repetir()
'Por.Dante Amor
CopiarTablero
If Sheets("Tablero").[Z2] = "x" Then Exit Sub
Application.OnTime Now + TimeValue("00:00:05"), "Repetir", , True
End Sub
Sub Detener()
'Por.Dante Amor
Sheets("Tablero").[Z2] = "x"
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:05"), "Detener", , False
End Sub
Sub CopiarTablero()
'Por.Dante Amor
Set h1 = Sheets("IGPA")
Set h2 = Sheets("Tablero")
'
ini = h2.[Z1]
If ini = "" Then
ini = 3
End If
h2.Range("B4:G13").Clear
'
For i = ini + 1 To h1.Range("F" & Rows.Count).End(xlUp).Row + 20
If h1.Cells(i, "F") = "" Then
fin = i - 1
Exit For
End If
Next
'
n = 0
For i = fin + 1 To h1.Range("F" & Rows.Count).End(xlUp).Row + 20
If h1.Cells(i, "F") <> "" Then
h2.[Z1] = i
Exit For
End If
n = n + 1
If n = 10 Then
h2.[Z1] = 3
Exit Sub
End If
Next
h1.Range("F" & ini & ":K" & fin).Copy h2.[B4]
bordes h2
End Sub
Sub bordes(h2)
'Por.Dante Amor
With h2.Range("B4:G13")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End SubSaludos.Dante Amor
¡Gracias! Dante por tomarte la moestia de hacer todo ese trabajo. Estoy implementadola en mi libro, ya te comento como me fue.
Muchas gracias!!.
Dante, he implementado la macro que tan profesional y amablemente has preparado, funciona muy bien.
Sin embargo, aún no me está tomando la información del ultimo cuadro. Que cambio le debo hacer a tu macro para que me incluya la información de ese ultimo cuadro?.
También quisiera que los datos fueran copias al Tablero, sin tener en cuenta el formato que tienen originalmente, que se peguen con formato Texto o Valores, sin las Fórmulas ni el rellono de fondo de las celdas originales.
Gracias y que pena abusar.
Luis Carlos
Hay un detalle, como ya te había comentado, tienes celdas combinadas en tu tablero, si las copiamos como valores, se perderá la celda combinada.
Si pudieras armar tus tableros sin celdas combinadas, sería más sencillo el copiar y pegar, pero si quieres conservar las celdas combinadas, habría que revisar celda por celda del tablero, copiar valor y luego combinar la celda.
Ese es otro trabajo, entonces podrías crear otra pregunta por cada petición.
