Copiar datos de una hoja y crear un libro nuevo
Deseo copiar datos de una hoja según texto de una columna se cree un libro nuevo con varias hojas. Según condición de la columna de la hoja de origen que separe y mande a sus hojas respectivas.
2 respuestas
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
Respecto a mi consulta lo que deseo realizar es una copia de los datos de la columna AA donde tengo guardado proceso activo, siendo 5 procesos que se dividen en Proceso 1, Proceso 2, Proceso 3, Destrucción y Aduana.
Que el nuevo libro este nombrado por el mes donde se esta generando el reporte, ya que los datos se modifican y cambian todos los días hoy puede estar en el Proceso 1 y al día siguiente en alguno de los otros 4 Procesos.
La información estaría en una hoja llamada Data donde se hace en consolidado de todo.
Que se separe la información según el proceso de la columna AA y guarde en hoja correspondiente a su proceso.
- Compartir respuesta
![](/content/images/user_nophoto_small.png)
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Vamos a entender un poco tu pedido.
Tienes un libro en el cual tienes 5 hojas... Proceso 1, Proceso 2, Proceso 3; Distribución y Aduana.
Tu quieres pasar a un libro nuevo los datos de estas hojas a un libro nuevo igual, ¿pero qué su nombre sea el nombre de la hoja activa y la hoja donde se peguen los datos se llame Data?..
O bien por favor pega lo que quieres así lo entiendo para poder darte una mano.
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
Si tengo un libro con varias hojas pero quiero crear uno nuevo con esas 5 hojas, la información la extraeria de mi hoja llamada Data donde tengo todo consolidado, según la columna AA separar por proceso en un nuevo libro y guardar con el nombre del mes el libro a manera de reporte mensual
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Perdon por tardar en responder, el trabajo esta a full.
Te paso el codigo vos lo adecuas a tu necesidad.
'Olavarria
Dim Destino As Workbook, _
Origen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
Origen1 As Excel. Range, Origen2 As Excel. Range, Origen3 As Excel. Range, Origen4 As Excel.Range, _
Destino1 As Excel. Range, Destino2 As Excel. Range, Destino3 As Excel. Range, Destino4 As Excel.Range, _
Nombre As String, nombres As String, nombre1 As String, nombre2 As String, nombre3 As String, _
nombre4 As String, nombre5 As String, nombre6 As String
Dim ws As Worksheet
'Creo libro de destino
Set Destino = Workbooks.Open(ActiveWorkbook.Path & "\LibroTemporal.xlsx")
'Activo libro
ThisWorkbook.Activate
nombre = Range("H9").Value
nombres = Range("i9").Value
nombre1 = Range("j9").Value
nombre2 = Range("k9").Value
'hojas de origen y destino
Set Origen = Worksheets("Data")
Destino.Worksheets.Add.Name = nombre
Destino.Worksheets.Add.Name = nombres
Destino.Worksheets.Add.Name = nombre1
Destino.Worksheets.Add.Name = nombre2
nombre3 = nombre
nombre4 = nombres
nombre5 = nombre1
nombre6 = nombre2
'celdas de origen y destino
Const celdaOrigen2 = "h9:h18"
Const celdaDestino2 = "h9:h18"
Const celdaOrigen3 = "i9:i18"
Const celdaDestino3 = "i9:i18"
Const celdaOrigen4 = "j9:j18"
Const celdaDestino4 = "j9:j18"
Const celdaOrigen5 = "k9:k18"
Const celdaDestino5 = "k9:k18"
'Celdas y hojas de origen y destino
Set Origen1 = Origen.Range(celdaOrigen2)
Set Destino1 = Destino.Worksheets(nombre3).Range(celdaDestino2)
Set Origen2 = Origen.Range(celdaOrigen3)
Set Destino2 = Destino.Worksheets(nombre4).Range(celdaDestino3)
Set Origen3 = Origen.Range(celdaOrigen4)
Set Destino3 = Destino.Worksheets(nombre5).Range(celdaDestino4)
Set Origen4 = Origen.Range(celdaOrigen5)
Set Destino4 = Destino.Worksheets(nombre6).Range(celdaDestino5)
'Seleccionar celdas origen
Origen1.Select
Origen2.Select
Origen3.Select
Origen4.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection. Copy
'Pegar datos en destino
Destino1. PasteSpecial xlPasteValues
Destino2. PasteSpecial xlPasteValues
Destino3. PasteSpecial xlPasteValues
Destino4. PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Guardar y cerrar el libro de Excel con la fecha que quiero
Destino. SaveAs (Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx")
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
Buen día si comprendo estoy intentando adecuarlo a lo que necesito pero me da un error en la línea donde se crea el libro de destino ya que ahí se necesitan 5 hojas te paso las modificaciones que realice.
Sub Reporte()
Dim Destino As Workbook, _
Origen As Excel.Worksheet, _
wsDestino As Excel.Worksheet, _
Origen1 As Excel.Range, Origen2 As Excel.Range, Origen3 As Excel.Range, Origen4 As Excel.Range, Origen5 As Excel.Range, _
Destino1 As Excel.Range, Destino2 As Excel.Range, Destino3 As Excel.Range, Destino4 As Excel.Range, Destino5 As Excel.Range, _
Nombre As String, nombres As String, nombre1 As String, nombre2 As String, nombre3 As String, _
nombre4 As String, nombre5 As String, nombre6 As String, nombre7 As String, nombre8 As String
Dim ws As Worksheet
'Creo libro de destino
Set Destino = Workbooks.Open(ActiveWorkbook.Path & "\LibroTemporal.xlsx")
'Activo libro
ThisWorkbook.Activate
Nombre = Range("A2").Value
nombres = Range("A2").Value
nombre1 = Range("A2").Value
nombre2 = Range("A2").Value
nombre3 = Range("A2").Value
'hojas de origen y destino
Set Origen = Worksheets("Data")
Destino.Worksheets.Add.Name = Nombre
Destino.Worksheets.Add.Name = nombres
Destino.Worksheets.Add.Name = nombre1
Destino.Worksheets.Add.Name = nombre2
Destino.Worksheets.Add.Name = nombre3
nombre4 = Nombre
nombre5 = nombres
nombre6 = nombre1
nombre7 = nombre2
nombre8 = nombre3
'celdas de origen y destino
Const celdaOrigen2 = "A2:AF"
Const celdaDestino2 = "A2:AF"
Const celdaOrigen3 = "A2:AF"
Const celdaDestino3 = "A2:AF"
Const celdaOrigen4 = "A2:AF"
Const celdaDestino4 = "A2:AF"
Const celdaOrigen5 = "A2:AF"
Const celdaDestino5 = "A2:AF"
Const celdaOrigen6 = "A2:AF"
Const celdaDestino6 = "A2:AF"
'Celdas y hojas de origen y destino
Set Origen1 = Origen.Range(celdaOrigen2)
Set Destino1 = Destino.Worksheets(nombre3).Range(celdaDestino2)
Set Origen2 = Origen.Range(celdaOrigen3)
Set Destino2 = Destino.Worksheets(nombre4).Range(celdaDestino3)
Set Origen3 = Origen.Range(celdaOrigen4)
Set Destino3 = Destino.Worksheets(nombre5).Range(celdaDestino4)
Set Origen4 = Origen.Range(celdaOrigen5)
Set Destino4 = Destino.Worksheets(nombre6).Range(celdaDestino5)
Set Origen5 = Origen.Range(celdaOrigen6)
Set Destino5 = Destino.Worksheets(nombre7).Range(celdaDestino6)
'Seleccionar celdas origen
Origen1.Select
Origen2.Select
Origen3.Select
Origen4.Select
Origen5.Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
'Pegar datos en destino
Destino1.PasteSpecial xlPasteValues
Destino2.PasteSpecial xlPasteValues
Destino3.PasteSpecial xlPasteValues
Destino4.PasteSpecial xlPasteValues
Destino5.PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Guardar y cerrar el libro de Excel con la fecha que quiero
Destino.SaveAs (Format(Now(), "DD-MMM-YYYY hh mm AMPM") & ".xlsx")
End Sub
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Primero el librotemporal debe estar guardado en la misma carpeta donde el libro original. O Bien debes cambiar la ruta
Segundo: Tienes repetido el nombre de las hojas, no se pueden duplicar.
Nombre = Range("A2").Value
nombres = Range("A2").Value ecel no permite el duplicado.
en caso de necesitar esto hace asi Nombre = Range("A2" + "ZZ1").Value , asi haces con todos
Vos solicitas que 5 hoja tengan los siuguientes nombres Proceso 1, Proceso 2, Proceso 3; Distribución y Aduana.
Bien en Nombre = Range("A2").Value debes poner en que celda se encuentra cada nombre. :
Proceso 1 esta en a3 debes poner Nombre = Range("A3").Value , si Proceso 2 esta en a4 debes poner Nombre = Range("A4").Value , asi sucecibamente.
Si lo nombres no los y debes colocarlos vos, debes borrar todo esto Nombre = Range("A2").Value y
Cambiar esta parte.
Destino.Worksheets.Add.Name = Nombre por Destino.Worksheets.Add.Name = "Proceso 1" y asi con todo
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Si lo nombres no los tienes en ninguna celda y debes colocarlos vos, debes borrar todo esto Nombre = Range("A2").Value
Cambiar esta parte.
Destino.Worksheets.Add.Name = Nombre por Destino.Worksheets.Add.Name = "Proceso 1" y asi con todo
Cualquier cosa pásame el libro y lo vemos
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
Agradezco mucho la orientación y si tengo el libro guardado en al misma carpeta donde está el original pero me dice error 1004 en tiempo de ejecución por ortografía.
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
El nombre de los procesos están en la columna AA y empieza desde la fila 2 pero como son datos que pueden cambiar de proceso el nombre no es el mismo entonces de ahí quiero tomar el nombre y llevarlo el nuevo libro con hojas con los mismo nombres de los procesos
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Perdon por la tardanza es que debemos entregar un trabajo y estamos a full.
Al ver tu archivo trabajas con filtros por lo tanto prueba con este codigo, cualquier cosa debes adaptarlo
Sub Copiar_filtro()
'olavarria
Dim destino As Workbook
'Busco la celda activa del filtro para darle nombre a la hoja de destino
ActiveSheet.AutoFilter.Range.Copy
Range("AA1").Select
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.EntireRow.Hidden = False
ActiveCell.Offset(1, 0).Select
Loop
'paso la celda activo a una variante
ultimafila = ActiveCell.Value
'------------Detecta si existe un filtro, si no existe termina la macro-----------------------------------------------------------------------------------------
If ActiveSheet.AutoFilterMode = False Then
Exit Sub
End If
'------------Se selecciona el rango que se ha filtrado, se copia, se abre un nuevo libro de excel y se pega el rango copiado en la Hoja1 de este nuevo libro----
ActiveSheet.AutoFilter.Range.Copy
Workbooks.Add.Worksheets(1).Paste
'Aqui cambio el nombre por la celda activa
ActiveSheet.Name = ultimafila
'------------Ajusta el tamaño de las columnas de la información que se filtró inicialmente en el nuevo libro donde fue pegada-----------------------------------
Cells.EntireColumn.AutoFit
'------------En caso de crear las hojas vacías del nuevo libro que se generan por default cuando éste se abre (Hoja 2 y Hoja3) borrar '-------------------------------------------
Application.DisplayAlerts = False
'Sheets("Hoja1").Delete
'Sheets("Hoja2").Delete
'Sheets("Hoja3").Delete
'Coloco el nombre al libro basado en la fecha de creacion, se puede cambiar
ActiveWorkbook.SaveAs (Format(Now(), "DD-MMM-YYYY") & ".xlsx")
'Si lo quiero cerrar sacar el '
'Activeworbook.close
![Darack Dragon](http://blob.todoexpertos.com/letters/D_45_48.png?v=1)
No he podido resolver este problema de trasladar la información a nuevo libro como un reporte mensual.
![Olavarria Citi](http://blob.todoexpertos.com/avatars/sm/jbi8hg5ynhzsc.jpg?v=16)
Estimado tengo para pasarle el archivo que me envío, tiene algunos cambios Ud los notara. De no ser útil, lo puede modificar como Ud lo desee.
https://drive.google.com/file/d/1nQ5va_36tG0hhQUKsUtOSdR7Ehh7URnR/view?usp=sharing
- Compartir respuesta
![](/content/images/user_nophoto_small.png)