Copiar datos de una hoja y crear un libro nuevo

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.

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

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")

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

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

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

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.

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

Buenas tardes envío link del libro que estoy trabajando.

https://1drv.ms/x/s!Ati7ezQJsOhJdAN9yNBmdW-2yC8?e=2Ql1Td 

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

Sigo igual no puedo realizar el proceso como se deseo, para los reportes de manera automática.

No he podido resolver este problema de trasladar la información a nuevo libro como un reporte mensual.

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