¿Cómo exportar el contenido de un libro a un nuevo libro y que sean pegados como valores?
Hola amigos , los saludo con mucho gusto. Solicito un poco de su conocimiento para poder resolver un problemita, a continuación se los planteo.
Tengo un libro en excel que contiene 3 hojas,( hoja1x, hoja2y, hoja3z), y a su vez estas contienen datos desde la celda a10.
La hoja 1x tiene datos desde a10 hasta columna G, de ahí en adelante las columnas están ocultas.
La hoja 2y tiene datos desde a10 hasta columna J, de ahí en adelante las columnas están ocultas.
La hoja 3z tiene datos desde a10 hasta columna K, de ahí en adelante las columnas están ocultas.
Lo que necesito es que esta información se pueda exportar a un nuevo libro, copiando los datos de las hojas a partir de las celdas "a10" y hasta la ultima fila, conservando los nombres de las hojas y siendo solo valores.
Nota: Es importante que la macro sólo copie desde la celda "a10", ya que arriba de ella hay información que no deseo exportar.
He intentado varias opciones, pero no resultan como deseo.
1.- macro3
Sub Macro3()
Range("a9:c" & Range("a65000").End(xlUp).Row).Select
Sheets(Array("Hoja1", "Hoja2", "Hoja3")).Select
Sheets("Hoja1").Activate
Selection.Copy
Workbooks.Add
Range("A10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("B4").Select
End Sub
El problema con esta macro es que no puedo copiar mas allá de la columna G, porque las de las hojas 1y, 2z sobrepasan esa columna.
2.- Macro copiar
Sub copiar()
Dim nom As Variant
Sheets(Array("Hoja1", "Hoja2")).Copy
nom = InputBox("Introduzca un nombre válido para su archivo, sin extensión", "Nombre del archivo")
On Error GoTo Fin
ActiveWorkbook.SaveAs Filename:=nom & ".xls", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Fin:
End Sub
El problema con esta macro es que copia todas las hojas sin importar el rango que deseo, ademas copia con formulas y yo solo deseo copiar y pegar como valores en el nuevo libro.
Espero me puedan ayudar amigos, de antemano agradezco su tiempo. Saludos.
1 respuesta
Intenta con esta macro:
Sub copiar_hojas()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1x")
Set h2 = l1.Sheets("Hoja2y")
Set h3 = l1.Sheets("Hoja3z")
u1 = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row
u2 = h2.UsedRange.Rows(h1.UsedRange.Rows.Count).Row
u3 = h3.UsedRange.Rows(h1.UsedRange.Rows.Count).Row
Set l2 = Workbooks.Add
l2.Sheets.Add after:=l2.Sheets(l2.Sheets.Count)
ActiveSheet.Name = h1.Name
h1.Range("A10:G" & u1).Copy
ActiveSheet.Range("A10").PasteSpecial Paste:=xlPasteValues
l2.Sheets.Add after:=l2.Sheets(l2.Sheets.Count)
ActiveSheet.Name = h2.Name
h2.Range("A10:J" & u2).Copy
ActiveSheet.Range("A10").PasteSpecial Paste:=xlPasteValues
l2.Sheets.Add after:=l2.Sheets(l2.Sheets.Count)
ActiveSheet.Name = h3.Name
h3.Range("A10:K" & u3).Copy
ActiveSheet.Range("A10").PasteSpecial Paste:=xlPasteValues
For Each h In l2.Sheets
If h.Name <> h1.Name And h.Name <> h2.Name And h.Name <> h3.Name Then
h.Delete
End If
Next
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
