Sub Save_ACTIVE_SHEET_to_PATH_Workbook()

'

' Save_ACTIVE_SHEET_to_PATH_Workbook Makro



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

'   https://www.herber.de/forum/messages/1984810.html - Solution from 15 July 2024  - ralf_b



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

'   English:

'   1. The default path can be customised in the line below -> Path = Path & "\".

'      Example (complete line): Path = "C:\Everything\Tests\"

'      After calling up the macro, the self-defined path is already suggested in the input field.

'      After confirming by clicking on the "OK" button, the file is saved in the specified path.

'

'   2. If, after calling the macro, the input field is overwritten with a self-defined PATH - 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!

'      A path with spaces must NOT be placed in inverted commas, otherwise the file will be saved in the defined default path!

'

'   3. If the content of the input field is [accidentally] DELETED after the macro is called up, NO file is saved.



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

'   German:

'   1. Der Standardpfad kann in der unten angeführten Zeile -> Path = Path & "\" angepasst werden.

'      Beispiel (komplette Zeile): Path = "C:\Everything\Tests\"

'      Nach Aufruf des Makros wird der selbst definierte Pfad im Eingabefeld bereits vorgeschlagen.

'      Nach Bestätigung mit Klick auf den Button "OK" wird die Datei im angegebenen Pfad gespeichert.

'

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

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

'      Ein Pfad mit Leerzeichen darf NICHT in Anführungszeichen gesetzt werden, ansonsten wird die Datei in dem definierten Standardpfad gespeichert!

'

'   3. Wird nach Aufruf des Makros der Inhalt vom Eingabefeld [versehentlich] GELÖSCHT, dann wird KEINE Datei gespeichert.

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



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

  Path = InputBox(msg, "Choose Filepath", ActiveWorkbook.Path)

    Select Case Right(Path, 1)

        Case ""

        GoTo ErrorHandler

        Case Is <> "\"

'       Path = Path & "\"   ... insert the desired [network] path in the next line | German: Füge den gewünschten [Netzwerk-]Pfad in der nächsten Zeile ein

        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