Cómo hacer un respaldo en otro libro de ciertas hojas al cerrar un libro de Excel

H o l a:

Pon la siguiente macro en los eventos de tu libro.

Cambia "Hoja1" y "Hoja2", por lo nombres de hojas que desees respaldar.

Cambia "respaldo.xlsx" por el nombre del archivo que contendrá el respaldo. Este archivo deberá estar en la misma carpeta donde tienes el archivo, o bien, si lo prefieres en otra carpeta, cambia esta línea:

ruta = l1.Path & "\"

Por una carpeta, por ejemplo:

ruta = "C:\trabajo\respaldo\"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    ruta = l1.Path & "\"
    arch = "respaldo.xlsx"
    If Dir(ruta & arch) <> "" Then
        Set l2 = Workbooks.Open(ruta & arch)
        l1.Sheets("Hoja1").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Hoja2").Copy after:=l2.Sheets(l2.Sheets.Count)
        l2.Save
        l2.Close
        MsgBox "Respaldo con éxito", vbInformation, "RESPALDAR"
    Else
        MsgBox "No existe el archivo respaldo", vbCritical, "RESPALDAR"
    End If
End Sub

Instrucciones para poner la macro en los eventos ThisWorkbook

1. Abre tu libro de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
4. Del lado derecho copia la macro

':)
':)

Hola, gracias por tu apoyo, la macro funciona bien, el único problema es que al abrir varias veces el libro hace el respaldo de las hojas y las repite no las sustituye o actualiza, es decir, en el libro "respaldo.xlsx" va adicionando hojas: hoja1, hoja2, luego al siguiente respaldo hoja1, hoja2, hoja1(2), hoja2(2), luego hoja1, hoja2, hoja1(2), hoja2(2), hoja1(3), Hoja2(3) y así sucesivamente. Solo ese pequeño detalle, Gracias!!

Te anexo la macro actualizada

Sub Respaldar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    ruta = l1.Path & "\"
    arch = "respaldo.xlsx"
    If Dir(ruta & arch) <> "" Then
        Set l2 = Workbooks.Open(ruta & arch)
        For Each h In l2.Sheets
            h.Name = "borrar " & h.Index
        Next
        l1.Sheets("Hoja1").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Hoja2").Copy after:=l2.Sheets(l2.Sheets.Count)
        For Each h In l2.Sheets
            If Left(h.Name, 6) = "borrar" Then
                h.Delete
            End If
        Next
        l2.Save
        l2.Close
        MsgBox "Respaldo con éxito", vbInformation, "RESPALDAR"
    Else
        MsgBox "No existe el archivo respaldo", vbCritical, "RESPALDAR"
    End If
End Sub

':)
':)

Ahora no respalda nada, tampoco sale el mensaje "respaldo con éxito", el archivo de respaldo se encuentra en la misma ruta del archivo original, da la impresión que no se ejecuta.

Tienes que tener 2 hojas en tu archivo, y deben tener los nombres "hoja1" y "hoja2".

¿Cambiaste algo en la macro?

¿Tienes las macros habilitadas en tu archivo?

La macro la pusiste en el archivo que tiene las hojas "hoja1" y "hoja2"

¿El archivo respaldo está cerrado?

Revisa lo anterior y prueba nuevamente.

Sub Respaldar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    ruta = l1.Path & "\"
    arch = "Respaldo Análisis.xlsx"
    If Dir(ruta & arch) <> "" Then
        Set l2 = Workbooks.Open(ruta & arch)
        For Each h In l2.Sheets
            h.Name = "borrar " & h.Index
        Next
        l1.Sheets("Predio").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Resultados Laboratorio").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Recomendaciones").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Análisis Foliar").Copy after:=l2.Sheets(l2.Sheets.Count)
        For Each h In l2.Sheets
            If Left(h.Name, 6) = "borrar" Then
                h.Delete
            End If
        Next
        l2.Save
        l2.Close
        MsgBox "Respaldo con éxito", vbInformation, "RESPALDAR"
    Else
        MsgBox "No existe el archivo respaldo", vbCritical, "RESPALDAR"
    End If
End Sub

Así es como está la macro en ThisWokBook, son las hojas que debo respaldar, y no lo hace, la primera macro si funcionaba solo era que repetía las hojas. Saludos

Disculpa, te envié mi macro de pruebas.

Cambia la macro de thisworkbook por esta:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    ruta = l1.Path & "\"
    arch = "respaldo.xlsx"
    If Dir(ruta & arch) <> "" Then
        Set l2 = Workbooks.Open(ruta & arch)
        For Each h In l2.Sheets
            h.Name = "borrar " & h.Index
        Next
        l1.Sheets("Hoja1").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Hoja2").Copy after:=l2.Sheets(l2.Sheets.Count)
        For Each h In l2.Sheets
            If Left(h.Name, 6) = "borrar" Then
                h.Delete
            End If
        Next
        l2.Save
        l2.Close
        MsgBox "Respaldo con éxito", vbInformation, "RESPALDAR"
    Else
        MsgBox "No existe el archivo respaldo", vbCritical, "RESPALDAR"
    End If
End Sub

Hola, me da error 52 en tiempo de ejecución, "nombre o número de archivo incorrecto" y al depurar me señala esta línea" If Dir(ruta & arch) <> "" Then". Cuando sustituyo "ruta=l1.Path & "\"", por la ruta real me da el mensaje "No existe el archivo respaldo" y si al final de la ruta real pongo el nombre del archivo también me dice lo mismo, te envío cómo está:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    ruta = "C:\Users\Oscar\OneDrive\Seprotec\INFORMACION TECNICA\ANALISIS DE SUELOS"
    arch = "Respaldo Análisis.xlsx"
    If Dir(ruta & arch) <> "" Then
        Set l2 = Workbooks.Open(ruta & arch)
        For Each h In l2.Sheets
            h.Name = "borrar " & h.Index
        Next
        l1.Sheets("Predio").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Resultados Laboratorio").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Recomendaciones").Copy after:=l2.Sheets(l2.Sheets.Count)
        l1.Sheets("Análisis Foliar").Copy after:=l2.Sheets(l2.Sheets.Count)
        For Each h In l2.Sheets
            If Left(h.Name, 6) = "borrar" Then
                h.Delete
            End If
        Next
        l2.Save
        l2.Close
        MsgBox "Respaldo con éxito", vbInformation, "RESPALDAR"
    Else
        MsgBox "No existe el archivo respaldo", vbCritical, "RESPALDAR"
    End If
End Sub

Saludos!!