Copiar y pegar celdas con macro
Quisiera saber si existe una macro que me copie las celdas activas de dos hojas a una hoja final.
Lo que tengo es lo siguiente, dos hojas con la misma cantidad de celdas "HOJA 1" y "HOJA 2", en las mismas el rango de celdas (A3:BZ30) puede tener o no datos (cabe aclarar que las filas y columnas vacias se ocultan automaticamente mediante una macro), entonces puedo tener en la HOJA 1 activas las celdas (A3:B10) y en HOJA 2 las celdas (A7:B33), lo que necesito es una macro que copie esos rangos y los pegue en una nueva hoja con nombre "CONSOLIDACIÓN" dejando entre pegado y pegado una fila libre.
¿Es posible de hacer esto?
1 Respuesta
H o l a:
Te anexo la macro, debes tener creadas las hojas Hoja1, Hoja2 y CONSOLIDACION.
Sub CopiarRango()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("CONSOLIDACION")
u = h3.Range("A3").SpecialCells(xlLastCell).Row
If u < 3 Then u = 3
h3.Range("A3:BZ" & u).ClearContents
'
n = h1. Range("A3:BZ30"). SpecialCells(xlCellTypeVisible). Rows.Count + 4
h1. Range("A3:BZ30"). SpecialCells(xlCellTypeVisible). Copy
h3. Range("A3"). PasteSpecial xlValues
h2. Range("A3:BZ30"). SpecialCells(xlCellTypeVisible). Copy
h3.Range("A" & n). PasteSpecial xlValues
Application.CutCopyMode = False
End Sub
Dante,
muchas gracias! Funciona muy bien, solo me queda que no solo copie los datos, sino los datos con sus respectivos formatos, ¿es posible realizar esto?
Muchas gracias.
Dante,
Quise agregar una nueva hoja y me sobre escribe los datos, quizás podrías ayudarme con esto a ver cómo agregar más hojas y que siempre los pegue dejando una línea libre desde el ultimo dato pegado.
Quisiera entender cómo realizarlo, no solo el código para hacerlo.
H o l a:
Te anexo la macro para pegar los formatos y para pegar después del último dato.
Sub CopiarRango()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("CONSOLIDACION")
maxi = 0
For i = Columns("A").Column To Columns("BZ").Column
u = h3.Cells(Rows.Count, i).End(xlUp).Row
If u > maxi Then
maxi = u
End If
Next
u = maxi + 2
H1. Range("A3:BZ30"). SpecialCells(xlCellTypeVisible). Copy
h3.Range("A" & u). PasteSpecial xlValues
h3.Range("A" & u). PasteSpecial xlPasteFormats
'
maxi = 0
For i = Columns("A").Column To Columns("BZ").Column
u = h3.Cells(Rows.Count, i).End(xlUp).Row
If u > maxi Then
maxi = u
End If
Next
u = maxi + 2
'
H2. Range("A3:BZ30"). SpecialCells(xlCellTypeVisible). Copy
h3.Range("A" & u). PasteSpecial xlValues
h3.Range("A" & u). PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End SubLa parte de agregar más hojas no te entiendo. Valora esta respuesta y me explicas lo que necesitas.
Dante,
Muchas gracias! Realmente funciona!
Ahora lo que preguntaba es, tengo "Hoja1" y "Hoja2", quisiera agregar una "Hoja3" y en algún futuro una "Hoja4" por ejemplo. La consulta es, cómo podría modificar el código para agregar estas hojas.
Muchas gracias!
H o l a:
Con todo gusto te ayudo con todas tus peticiones.
Valora esta respuesta y crea una nueva pregunta en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor"
sal u dos
