Crear nuevo Libro y copiar algunas hojas sobre el
Estmados, he tratado de darme vuelta en el asunto y aun no puedo conseguir el código.
Básicamente lo que quiero hacer es lo siguiente.
1. Tengo un Libo abierto con 15 hojas
2. Crear uno Nuevo
3. Copiar solo las primeras 13 hojas sobre el nuevo libro
4. Guardar el nuevo libro con un nombre Comun_fecha (la idea es realizar esta rutina diariamente y el reporte de solo 13 hojas se guarde en un archivo aparte.
Agradecería enormemente su ayuda, saludos cordiales.
Básicamente lo que quiero hacer es lo siguiente.
1. Tengo un Libo abierto con 15 hojas
2. Crear uno Nuevo
3. Copiar solo las primeras 13 hojas sobre el nuevo libro
4. Guardar el nuevo libro con un nombre Comun_fecha (la idea es realizar esta rutina diariamente y el reporte de solo 13 hojas se guarde en un archivo aparte.
Agradecería enormemente su ayuda, saludos cordiales.
1 Respuesta
Respuesta de santiagomf
1
Esta macro copia todas las páginas. Si quieres puedes quitar las que sea con una instrucción if sheets(i). name = ...... then.
Option Explicit
Sub copiarTodasLasPaginasEnLibroNuevo()
Dim i As Integer
Dim libroAct As String
Dim libroNew As String
Dim snPrimero As Boolean
' Guardamos el nombre del libro actual
libroAct = ActiveWorkbook.Name
snPrimero = True
' Para cada una de las páginas
For i = ThisWorkbook.Sheets.Count To 1 Step -1
Sheets(i).Select
If snPrimero Then
Sheets(i).Copy
libroNew = ActiveWorkbook.Name
snPrimero = False
Else
Sheets(i).Copy Before:=Workbooks(libroNew).Sheets(1)
End If
Windows(libroAct).Activate
Next i
Windows(libroNew). Activate
ActiveWorkbook. Save
End Sub
Option Explicit
Sub copiarTodasLasPaginasEnLibroNuevo()
Dim i As Integer
Dim libroAct As String
Dim libroNew As String
Dim snPrimero As Boolean
' Guardamos el nombre del libro actual
libroAct = ActiveWorkbook.Name
snPrimero = True
' Para cada una de las páginas
For i = ThisWorkbook.Sheets.Count To 1 Step -1
Sheets(i).Select
If snPrimero Then
Sheets(i).Copy
libroNew = ActiveWorkbook.Name
snPrimero = False
Else
Sheets(i).Copy Before:=Workbooks(libroNew).Sheets(1)
End If
Windows(libroAct).Activate
Next i
Windows(libroNew). Activate
ActiveWorkbook. Save
End Sub
