Copiar hojas del libro activo a otro evitando 3
Hola tengo la siguiente macro y trabaja bien se podría decir solo que no puedo hacer que copie en otro libro las hojas que están seleccionadas, que me falta hacer para que logre hacer esto.
Sub SelectAllSheets()
'selecciona todas las hojas del libro activo excepto 3
' Macro recorded 4/16/2008 by CDuarte
Dim ws As Worksheet
Dim fe As Workbook
Application.ScreenUpdating = False
'seleccionar primero la hoja desde donde se quiere incluir
Sheets(4).Select
For Each ws In ActiveWorkbook.Sheets
If ws.Index <> 1 And ws.Index <> 2 And ws.Index <> 3 Then
ws.Select False
End If
Next ws
Application.ScreenUpdating = True
End Sub
Sub SelectAllSheets()
'selecciona todas las hojas del libro activo excepto 3
' Macro recorded 4/16/2008 by CDuarte
Dim ws As Worksheet
Dim fe As Workbook
Application.ScreenUpdating = False
'seleccionar primero la hoja desde donde se quiere incluir
Sheets(4).Select
For Each ws In ActiveWorkbook.Sheets
If ws.Index <> 1 And ws.Index <> 2 And ws.Index <> 3 Then
ws.Select False
End If
Next ws
Application.ScreenUpdating = True
End Sub
1 Respuesta
Respuesta de tavopz
1
La verdad si hace lo que tu dices si pongo dentro del if esa isntruccion, pero no necesito que me copie una hoja, si todas en un solo libro si lo pongo fuera me da error así que no se como hacer para que me copie el resto de hojas en un solo libro sin tomar encuenta las 3 primeras hojas del libro original.
Espero haber aclarado si no avisas.
Gracias de antemano por tu ayuda
Espero haber aclarado si no avisas.
Gracias de antemano por tu ayuda
Prueba la siguiente macro:
Option Explicit
Option Base 0
Sub arreglodehojas()
Dim s As Object, x()
ReDim x(0)
For Each s In ActiveWorkbook.Sheets
If s.Index > 3 Then
x(UBound(x)) = s.Name
ReDim Preserve x(UBound(x) + 1)
End If
Next s
ReDim Preserve x(UBound(x) - 1)
Sheets(x). Copy
End Sub
Option Explicit
Option Base 0
Sub arreglodehojas()
Dim s As Object, x()
ReDim x(0)
For Each s In ActiveWorkbook.Sheets
If s.Index > 3 Then
x(UBound(x)) = s.Name
ReDim Preserve x(UBound(x) + 1)
End If
Next s
ReDim Preserve x(UBound(x) - 1)
Sheets(x). Copy
End Sub
Gracias, excelente era junto lo que necesitaba, aunque no entiendo algunas cositas de la macro pero me pondré a estudiarla. Cuidate y hasta la próxima.
