XL 2013 Absence de prompt enregistrement après macro

Sub DEVIS()

Sheets("REQUETE").Select

Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer

DBFullName = "Z:\POSE\DANWARE\DANWARE.accdb"

Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect

Dim Nbre As String
Dim Message As String, Titre As String, Defaut As String, Reponse As String
Message = "Entrez le code chantier :"
Titre = "SAISIE CODE CHANTIER"
Defaut = " "
Reponse = InputBox(Message, Titre, Defaut)
Nbre = (Reponse)
Dim Nbre1 As String
Dim Message1 As String, Titre1 As String, Defaut1 As String, Reponse1 As String
Message1 = "Entrez le code étude :"
Titre1 = "SAISIE CODE ETUDE"
Defaut1 = " "
Reponse1 = InputBox(Message1, Titre1, Defaut1)
Nbre1 = (Reponse1)

Set Recordset = New ADODB.Recordset
With Recordset
    Source = "SELECT * FROM R_ExportDevisPDG WHERE [CodeChantier] = '" & Nbre & "'"
   
    .Open Source:=Source, ActiveConnection:=Connection
   
For Col = 0 To Recordset.Fields.Count - 1
    Range("A4").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next

    Range("A4").Offset(1, 0).CopyFromRecordset Recordset
End With

Set Recordset = New ADODB.Recordset
With Recordset

If Nbre1 = " " Then

    Source = "SELECT * FROM R_ExportDevisTOTAL WHERE [CodeChantier] = '" & Nbre & "'"

Else
   
    Source = "SELECT * FROM R_ExportDevisTOTAL WHERE [CodeChantier] = '" & Nbre & "' AND [DescriptionAffaire] = '" & Nbre1 & "'"
       
End If
       
    .Open Source:=Source, ActiveConnection:=Connection

For Col = 0 To Recordset.Fields.Count - 1
    Range("A8").Offset(0, Col).Value = Recordset.Fields(Col).Name
Next

    Range("A8").Offset(1, 0).CopyFromRecordset Recordset
End With

Calculate
   
    ActiveWorkbook.Save
   
    Sheets("REQUETE").Activate
   
    Application.DisplayAlerts = False
    cell1 = Range("A5").Value
    cell2 = Range("B5").Value
    cell3 = Format(Range("I1"), "yyyy-mm-dd")
    Fpath = "Z:\Secretaire\DEVIS\DEVIS PREPARES\" ' <<<< to be changed
    Fname = Fpath & "DEVIS " & cell1 & " - " & cell2 & " - " & cell3 & ".xlsm"
   
    ActiveWorkbook.SaveCopyAs Filename:=Fname

    Workbooks.Open Filename:=Fname
   
    ActiveWorkbook.Save
      
    Sheets("REQUETE").Select
    Dim lastrow As Long
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row
    Range("A9:K" & lastrow).Sort key1:=Range("E9:E" & lastrow), order1:=xlAscending, Header:=xlNo
      
    Sheets("PdeG").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("OFFRE").Select
    Columns("A:E").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F7").Select
    ActiveCell.FormulaR1C1 = "=+RC[-1]*RC[-2]"
    Range("F7").Select
    Selection.Copy
    Range("F7:F96").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("F98").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUM(R[-91]C:R[-1]C)"
    Range("F100").Select
    ActiveCell.FormulaR1C1 = "=+R[-1]C*0.2"
    Range("F103").Select
    ActiveCell.FormulaR1C1 = "=+R[-3]C+R[-5]C"
    Range("F104").Select

Dim i As Integer
For i = 95 To 7 Step -2

If Cells(i, 2).Value = 0 Then Rows(i & ":" & i + 1).Delete

Next

    Sheets("REQUETE").Select
    ActiveWindow.SelectedSheets.Delete
   
    Sheets("PdeG").Select
    Range("A1").Select
      
    Windows("Devis.xlsm").Activate
   
    Sheets("REQUETE").Select
    Rows("4:399995").ClearContents
   
    Calculate
    ActiveWorkbook.Close SaveChanges:=True
   
End Sub