Sub Save_ACTIVE_SHEET_to_specified_PATH()



'   https://www.herber.de/forum/messages/1984803.html - Makro (bitte prüfen) - Aktives Blatt auf Desktop speichern

'   -----------------------------------------------------------------------------------------------------------------------------



'   English:

'   1. If the input field is left EMPTY after the macro is called, the Excel file is saved in the PATH,

'      which was defined in the MACRO. EXAMPLE: Path = "C:\Everything\Tests\"

'      It is NOT necessary to enter the file extension, e.g. .xlsm!

'

'   2. If the input field is FILLED with a PATH after the macro is called - followed by a BACKSLASH '\',

'      then the Excel file is saved in this path. It is NOT necessary to enter the file extension, e.g. .xlsm!

'   -----------------------------------------------------------------------------------------------------------------------------



'   German:

'   1. Wird nach Aufruf des Makros das Eingabefeld LEER gelassen, dann wird die Excel-Datei in jenem PFAD gespeichert,

'      welcher im MAKRO definiert wurde. BEISPIEL: Path = "C:\Everything\Tests\"

'      Die Angabe der Dateierweiterung, zB .xlsm ist NICHT erforderlich!

'

'   2. Wird nach Aufruf des Makros das Eingabefeld mit einem PFAD - abschließend mit einem BACKSLASH '\' BEFÜLLT,

'      dann wird die Excel-Datei in diesem Pfad gespeichert. Die Erfassung der Dateierweiterung, zB .xlsm ist NICHT erforderlich!

'   -----------------------------------------------------------------------------------------------------------------------------



    Dim lstrStdPfad As String

    lstrStdPfad = "C:\Everything\Tests\"

    Path = InputBox("Enter the path in which the sheet is to be saved - the file name extension (.xl??) is automatically added according to the file format!")

        If Mid(Path, 2, 1) <> ":" Then

            Path = lstrStdPfad

        End If

    Select Case Right(Path, 1)

        Case ""

        GoTo ErrorHandler

        Case Is <> "\"

        Path = "C:\Everything\Tests\"

    End Select

    ActiveSheet.Copy

    On Error GoTo ErrorHandler

'    ActiveWorkbook.SaveAs Filename:=path & ActiveSheet.Name                   => Excel 2003

'    ActiveWorkbook.SaveAs Filename:=path & ActiveSheet.Name, FileFormat:=52   => Excel 2010: The file name extension can be omitted,

'    https://www.herber.de/forum/archiv/1380to1384/1380461_Excel_2010_per_makro_tabellenblatt_in_neue_Datei.html  => Excel adds them automatically according to the file format.

    ActiveWorkbook.SaveAs Filename:=Path & ActiveSheet.Name, FileFormat:=52

ActiveWorkbook.Close Savechanges:=False

Exit Sub

ErrorHandler:

    Select Case Err.Number

        Case 1004

            MsgBox ("Saving was NOT successful! - Check the path...")

            ActiveWorkbook.Close Savechanges:=False

        Case Else

    End Select

End Sub