Backup de un archivo de excel.

Prueba agregándole un indice a cada una de tus copias

Sub RealizaCopia()
    PathActual = ActiveWorkbook.Path
    NombreLibro = PathActual + "\" + ActiveWorkbook.Name

   For indx = 1 to 3
       NombreCopia = Mid(NombreLibro, 1, Len(NombreLibro) - 4) & "_" &Format(Date, "YYYY.MM.DD") & "_" & indx & ".xls"
    ActiveWorkbook.SaveCopyAs Filename:=NombreCopia

  next
    MsgBox ("COPIA REALIZADA")
    End Sub

Quizás no me haya explicado bien, pero de lo que se trata es de guardar las 3 últimas copias del archivo. Cada una de estas copias se han ido guardando cada vez que el libro se abre.

Gracias

Buenos días a todos.

Necesito ayuda.

Quisiera que cada vez que se abra un libro excel, se haga copia de seguridad del mismo y se vayan guardando sólo las 3 últimas copias más recientes.

Gracias

No entiendo muy bien la lógica de tu pedido, primero me parece más lógico hacer el backup al guardar el archivo en lugar de abrirlo.

En fin a continuación un código que me lista los archivos de excel de una carpeta, luego los ordena (en tu caso como la fecha está incluida en el nombre del archivo poemos decir que lo ordena por fecha). Posteriormente me borra los backups mas antiguos (si hay mas de 3 - cuidado con el comando kill aqui) y la ultima parte sería con el código que tienes crear un archivo nuevo.

Public Fpath() As String 'Aqui se almacenan los archivos encontrados
Dim RutaActual As String 'Ruta donde se buscarán los archivos
Public Sub UpdateBackup()
    '1.- Obtenemos los archivos de excel de un directorio específico
    Call ListarFiles
    '2- Ordenamos los archivos para quedarnos con los 3 más actuales
    Call SortFiles
    ' realizamos copia del archivo actual
    Call RealizarCopia
End Sub

Public Sub ListarFiles()
'Variables definition
    Dim sName As String ' nombre del archivo encontrado
    Dim sFullName As String 'Ruta + nombre del archivo
    Dim isfile As Integer

   
    RutaActual = ThisWorkbook.Path & "\"
    sName = Dir(RutaActual & "*.xls", vbNormal)
    isfile = 0
    While Len(sName) > 0
        sFullName = RutaActual & sName
        If sName <> "." And sName <> ".." Then
              If (GetAttr(sFullName) And vbArchive) = vbArchive Then

                       ReDim Preserve Fpath(isfile)
                       Fpath(isfile) = spath & sName
                       isfile = isfile + 1
            End If    ' it represents a directory.
        End If
        sName = Dir    ' Get next entry.

    Wend
    nReps = isfile - 1
If isfile < 1 Then
        MsgBox ("No se encontró ningún archivo" & Chr(13) & "en el directorio especificado." _
        & Chr(13) & "Posiblemente no haya ningún archivo del tipo especificado.")
End If

Exit Sub
Fin1:
MsgBox Err.Description, vbExclamation
End
End Sub

Public Sub SortFiles()
'Una manera fácil de ordenar es copiar los nombres d elos archivos en Excel
Dim hoja As Worksheet
Dim max As Integer

max = UBound(Fpath) 'obtenemos el numero de archivos almacenados
Set hoja = ActiveWorkbook.Sheets.Add
For i = 0 To max
    hoja.Cells(i + 1, 1).Value = Fpath(i)
Next
   With hoja.Sort
        .SortFields.Add Key:=Range("A1"), Order:=xlDescending, DataOption:=xlSortTextAsNumbers
        .SetRange Range("A1", Selection.End(xlDown))
        .Apply
    End With
Application.DisplayAlerts = False
'solo tomamos los 3 últimos archivos
If max > 3 Then
    For i = 4 To max
        'borramos los archivos mas antiguos
       Kill RutaActual & Cells(i, 1).Value
    Next
End If
    hoja.Delete
   Application.DisplayAlerts = True
End Sub

LLevas razón, quizás sea más lógico guardar al cerrar el libro, pero también puede valer con guardar al abrir. Lo que sucede es que con la secuencia propuesta sí llega a crear el listado de archivos guardados en una hoja, pero no los borra. Da error en la línea: Kill RutaActual & Cells(i, 1).Value
Gracias

¿Qué tipo de error te sale?. A mi me salia error al inicio porque estaba mal el índice o porque necesitaba permisos especiales para operar en determinada carpeta (Culpa de windows 7)

El error que me sale es: "Se ha producido el error '70' en tiempo de ejecución.Permiso denegado"

Un cordial saludo

A mi también me sale ese error si trato de eliminar un libro que tengo abierto. Fíjate el nombre del archivo que aparece en el listado y si está abierto o que no esté en una carpeta protegida

Me sigue saliendo el mismo mensaje a pesar de que la carpeta no está protegida y los archivos a borrar no están abiertos.

Si gustas me puedes enviar tu archivo para ver que puede estar pasando

Buenas tardes

Te adjunto el archivo

https://www.dropbox.com/s/sazjaecu1uyv3t8/Libro11.zip?dl=0 

Gracias por tu interés