XL 2016 enregistrer sur le bureau chaque 5mn classeur actif sous son nom +1

Sub test()
' Trouve le non du fichier (complet)
    MsgBox ThisWorkbook.Name

' Trouver l'extension du fichier
    MsgBox Split(ThisWorkbook.Name, ".")(1)

' Trouve le non du fichier (sans l'extension)
    MsgBox Split(ThisWorkbook.Name, ".")(0)

' Trouve une valeur numérique (dans le nom du fichier "sans l'extension")
Dim i As Integer
Dim c As String
Dim temp As String
Dim NumChaine As Integer

    For i = 1 To Len(Split(ThisWorkbook.Name, ".")(0))
        c = Mid(Split(ThisWorkbook.Name, ".")(0), i, 1)
        If c >= "0" And c <= "9" Or c = "." Then temp = temp & c
    Next i
    NumChaine = Val(temp)
    MsgBox NumChaine

' Trouve le non du fichier sans la valeur numérique (suppression de la valeur numérique dans le nom du fichier "sans l'extension")
MsgBox Left(Split(ThisWorkbook.Name, ".")(0), Len(Split(ThisWorkbook.Name, ".")(0)) - Len(NumChaine))

' Incremetation du Numéréro du fichier + 1 (Nom du fichier + l'ancienne valeur numérique incrémenté de +1 chiffre)
Dim NouveauNomFichier As String
NouveauNomFichier = Left(Split(ThisWorkbook.Name, ".")(0), Len(Split(ThisWorkbook.Name, ".")(0)) - Len(NumChaine)) & NumChaine + 1
MsgBox NouveauNomFichier

' soit en remplacement par une variable (du nombre de caractère du fichier sans sa valeur numérique)
' ThisWorkbook.SaveAs ThisWorkbook.Path & "\enregistrement" & Val(Mid(ThisWorkbook.Name, 15)) + 1
' Entre crochet ' ThisWorkbook.SaveAs ThisWorkbook.Path & ["\enregistrement" & Val(Mid(ThisWorkbook.Name, 15)) + 1]
' par
' ' Entre crochet ' ThisWorkbook.SaveAs ThisWorkbook.Path & NouveauNomFichier

' ici
MsgBox Val(Mid(ThisWorkbook.Name, 15)) - 3
MsgBox Val(Mid(ThisWorkbook.Name, Len(NouveauNomFichier) - 1)) - 3
' Kill ThisWorkbook.Path & ["\enregistrement" & Val(Mid(ThisWorkbook.Name, 15))] - 3 & ".xlsm"
' Kill ThisWorkbook.Path & NouveauNomFichier - 3 & ".xlsm"
End Sub

Public t# 'mémorise la variable

Sub Enregistrer()
Dim chemin$, fichier$, a(), n&
chemin = ThisWorkbook.Path & "\"
ThisWorkbook.SaveAs chemin & "enregistrement " & Format(Now, "dd-mm-yy hh-mm-ss")
On Error Resume Next
Application.OnTime t, "Enregistrer", , False
t = Now + 5 / 1440 'délai de 5 minutes
Application.OnTime t, "Enregistrer"
fichier = Dir(chemin & "enregistrement*.xlsm")
While fichier <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = CDate(Mid(fichier, 16, 9) & Replace(Mid(fichier, 25, 8), "-", ":"))
    If a(n) <> "" Then n = n + 1
    fichier = Dir
Wend
tri a, 0, UBound(a)
'---on ne garde que les 2 derniers fichiers---
For n = 0 To UBound(a) - 2
    Kill chemin & "enregistrement " & Format(a(n), "dd-mm-yy hh-mm-ss") & ".xlsm"
Next
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Sub Enregistrer()
Dim chemin$, x$, fichier$, a(), n&
chemin = ThisWorkbook.Path & "\"
x = Environ("Username") & "_isitelImmobProspection "
ThisWorkbook.SaveAs chemin & x & Format(Now, "dd-mm-yy hh-mm-ss")
On Error Resume Next
Application.OnTime t, "Enregistrer", , False
t = Now + 5 / 1440 'délai de 5 minutes
Application.OnTime t, "Enregistrer"
fichier = Dir(chemin & x & "*.xlsm")
While fichier <> ""
    ReDim Preserve a(n) 'base 0
    a(n) = CDate(Mid(fichier, Len(x) + 1, 8) & Replace(Mid(fichier, Len(x) + 9, 9), "-", ":"))
    If a(n) <> "" Then n = n + 1
    fichier = Dir
Wend
tri a, 0, UBound(a)
'---on ne garde que les 2 derniers fichiers---
For n = 0 To UBound(a) - 2
    Kill chemin & x & Format(a(n), "dd-mm-yy hh-mm-ss") & ".xlsm"
Next
End Sub