[ChrisGT7]

Καλησπέρα Γιώργο,

Αντικατέστησε τον κώδικα του αρχείου με τον παρακάτω:

Option Explicit

Sub EKTYPWSH_PARASTATIKOY()
    On Error GoTo InvalidFile
    Dim Fld As FileDialog
    Set Fld = Application.FileDialog(msoFileDialogFolderPicker)
    
    With Fld
        .Title = "Επιλέξτε φάκελο αποθήκευσης"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then Exit Sub
        Dim FPath As String
        FPath = .SelectedItems(1)
    End With

    Application.DisplayAlerts = False
    ActiveSheet.Copy
    With ActiveWorkbook
        .ActiveSheet.Shapes.SelectAll
        Selection.Delete
        .SaveAs Filename:=FPath & "\" & [J5] & ", " & [D7] & ", " & _
            Format([J3], "dd.mm.yy") & ".xlsx", FileFormat:=51
        Application.Dialogs(xlDialogPrint).Show
        .Close False
    End With
    [J5] = [J5] + 1
    Application.DisplayAlerts = True
    
InvalidFile:
    If Err.Number = 0 Then Exit Sub
    MsgBox "Σφάλμα αποθήκευσης!", vbCritical, "ΣΦΑΛΜΑ"
    Application.DisplayAlerts = True
End Sub