VBA que copie todas las hojas en otro archivo

No me queda claro si necesitas que copie cada hoja en nuevos libros (separados)... o todas las hojas en el mismo libro que estás creando desde tu código, y en ese caso si cada hoja se copia en hojas separadas o a continuación de lo ya pegado.

Porque si vas a copiar todas las hojas de tu libro en un libro nuevo con todas las hojas del anterior.... Directamente guarda el libro activo como copia y solo necesitas una macro para limpiar los rangos.

Aclara un poco más cuál es tu requerimiento y con mucho gusto te completaré la macro.

Efectivamente lo que necesito es que todas las hojas se copien en un nuevo libro

Si todas las hojas se copian de modo completo podrías utilizar solo esto:

Private Sub CommandButton1_Click()
Dim Fecha As String
On Error Resume Next
'establecer el nombre para el libro
ruta = ThisWorkbook.Path
Fecha = Format(Now, "dd-mm-yyyy hh.mm.ss")
'guardar copia sin macros
ActiveWorkbook.SaveCopyAs ruta & "/" & Fecha & ".xlsx"
'limpieza del libro activo
'siguen tus instrucciones

Pero como seleccionas un rango entonces tu macro ajustada quedaría así:

Private Sub CommandButton1_Click()
Dim Fecha As String
On Error Resume Next
'libro origen
libro1 = ActiveWorkbook.Name
'establecer el nombre para el nuevo libro
ruta = ThisWorkbook.Path
Fecha = Format(Now, "dd-mm-yyyy hh.mm.ss")
'abrir nuevo libro y guardar su nombre
Workbooks.Add
libro2 = ActiveWorkbook.Name
x = 1
'regresar al libro de la macro
Windows(libro1).Activate
cantHojas = ActiveWorkbook.Sheets.Count
'recorrer las hojas, copiarlas en libro nuevo
Application.ScreenUpdating = False
For i = 1 To cantHojas
    Sheets(i).Select
    Range("A1:Z100").Copy
    Windows(libro2).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets.Add After:=ActiveSheet
    Windows(libro1).Activate
Next i
'quitar última hoja agregada, guardar libro 2 sin macros y cerrarlo
Application.DisplayAlerts = False
Windows(libro2).Activate
ActiveSheet.Delete
ActiveWorkbook.SaveAs ruta & "/" & Fecha & ".xlsx"
ActiveWorkbook.Close
on error goto 0
'sigue la limpieza de todas las hojas. ++++ Macro de Jose Luis +++++
contador = Sheets.Count
For i = 1 To contador
    Sheets(i).Activate
    With ActiveSheet
        If .ProtectContents = True Then
            On Error Resume Next
            .UsedRange = ""
            On Error GoTo 0
        End If
    End With
Next i
End Sub

La parte de la limpieza supongo que ya la tendrás probada y veo que se ejecuta en todas las hojas.

Sdos y no olvides valorar las respuestas.

Elsa

se me copia la primera hoja varias veces en el mismo libro en lugar de copiarse cada una de las hojas

Mostrame cómo te quedó la macro porque volví a probarla y funciona perfecto.

Sdos!

Private Sub CommandButton1_Click()
Dim Fecha As String
On Error Resume Next
For Each C In Range("B9:AD10,AE9,AE10,AE11,AA11,W11,S11,M11,I11,F11,D11,B11,B12:AD12,AE12,AE13,B13:AD13,N14,AE14,AE15,B15:AD15,I16,J16,AE16,W17,B17")
If C.Value = "" Then
C.Interior.Color = vbRed
celdas = celdas & " " & C.Address(False, False)
existe = True
End If
Next

If existe Then
MsgBox "Falta informacion en las celdas : " & celdas
Exit Sub
End If

libro1 = ActiveWorkbook.Name

ruta = ThisWorkbook.Path
Fecha = Format(Now, "dd-mm-yyyy hh.mm.ss")

Workbooks.Add
libro2 = ActiveWorkbook.Name
x = 1

Windows(libro1).Activate
cantHojas = ActiveWorkbook.Sheets.Count

Application.ScreenUpdating = False
For i = 1 To cantHojas
Sheets(i).Select
Range("A1:Z100").Copy
Windows(libro2).Activate
Range("A1").Select
ActiveSheet.Paste
Sheets.Add After:=ActiveSheet
Windows(libro1).Activate
Next i

Application.DisplayAlerts = False
Windows(libro2).Activate
ActiveSheet.Delete
ActiveWorkbook.SaveAs Filename:="C:\Users\ND77017\Downloads\Control incendios " & Fecha & " .xlsx"
ActiveWorkbook.Close
On Error GoTo 0

contador = Sheets.Count
For i = 1 To contador
Sheets(i).Activate
With ActiveSheet
If .ProtectContents = True Then
On Error Resume Next
.UsedRange = ""
On Error GoTo 0
End If
End With
Next i
End Sub

La parte de mi código es correcta. Observa que se recorren todas las hojas:

For i = 1 To cantHojas
Sheets(i).Select        'se selecciona

          'instrucciones de pase

Sheets.Add After:=ActiveSheet     '

Windows(libro1).Activate     'volver al libro de inicio
Next i        'repetir el bucle para la siguiente hoja

Revisalo nuevamente. Podrías colocar un punto de interrupción luego de la instrucción:

Sheets(i).Select   para comprobar el pase de hojas.

Si no encontrás el problema enviame un libro con un par de hojas + el formulario . Mis correos aparecen en sitio que dejo al pie.

ya te envié el correo

Encontré un libro en carpeta Spam... no se me permite descargarlo... de todos modos no parece ser el de la consulta. ¿La macro es para exportar estas 2 hojas?

¿El botón CommandButton está en la hoja o en un Userform? Si tiene clave de apertura no te la olvides de agregarla en el correo.

Verifica y enviamelo nuevamente.

Sdos!

Imagen de intento de apertura

Lo he probado desde otro ordenador y desde otra cuenta y me deja acceder perfectamente aun así te lo reenvío por si acaso