Einzelnes Sheet in Excel Speichern

  • Excel

Es gibt 11 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Einzelnes Sheet in Excel Speichern

    Hallo Community,

    ich habe eine Excel Datei mit relativ vielen Sheets. Durch den Befehl subSpeichern wird die komplette Excel lokal auf dem Rechner
    in einen bestimmten Pfad gespeichert.
    Nun würde ich gerne einen Befehl subSpeichern2 erstellen, wo nur ein bestimmtes Sheet in einer anderen Excel Tabelle gespeichert wird.
    Dabei müssten die Daten immer überschrieben werden. Kann man die Funktion unten entsprechend anpassen und wenn ja wie?
    Danke

    Visual Basic-Quellcode

    1. Public Sub subSpeichern()
    2. Dim FSO As Object
    3. Dim strDateiname As String
    4. Dim strPfadname As String
    5. Dim WshShell As Object
    6. Dim strDokumente As String
    7. Set WshShell = CreateObject("WScript.Shell")
    8. Set FSO = CreateObject("Scripting.FileSystemObject")
    9. 'strDokumente = WshShell.SpecialFolders("MyDocuments")
    10. strDokumente = "C:\Users\User\Desktop\test"
    11. strPfadname = strDokumente
    12. strDateiname = "Formatierung1.xlsm"
    13. Err.Clear
    14. On Error Resume Next
    15. ' Lokal speichern
    16. If FSO.FolderExists(strPfadname) Then
    17. Application.DisplayAlerts = False ' verhindert Meldung zum Überschreiben einer vorhandenen Datei
    18. ActiveWorkbook.SaveAs Filename:=strPfadname & "\" & strDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
    19. Application.DisplayAlerts = True ' Meldungen wieder anzeigen
    20. If Err.Number <> 0 Then
    21. MsgBox "Fehler " & Err.Number & vbLf & Err.Description, vbCritical + vbOKOnly, "Fehler beim speichern"
    22. End If
    23. Else
    24. MsgBox strPfadname & vbLf & "Nicht vorhanden", vbCritical + vbOKOnly, "Fehler beim speichern"
    25. End If
    26. End Sub
    ActiveWorkbook sollte man (fast) nie verwenden.
    Das kann je nach Benutzeraktion auch mal ganz woanders hinzeigen.
    Wenn schon, dann ThisWorkbook.

    Und Nein:
    Worksheet ist eine Klasse. Du musst schon eine Instanz dieser Klasse angeben.
    z.B. Sheets("Tabelle1")
    Und wenn du die Aktion über einen Button auslöst, dessen Eventroutine in diesem Sheet steht, kannst du auch Me verwenden.
    Rein theoretisch wäre auch ActiveSheet möglich, aber da hast du dasselbe Problem wie bei ActiveWorkbook, dass der Benutzer dir durch einen Mausklick ins Handwerk pfuschen kann.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo

    Danke erstmal für deine Hilfestellungen.
    Ich habe jetzt einfach mal Sheets("Bestandsmanagement").SaveAs eingefügt, aber bekomme einen "Anwendungs oder objektorierntieren Fehler"

    Das Sheet sollte in eine andere Excel gespeichert werden und wenn dieses Sheet schon exiiert, müsste dieses überschrieben werden.

    Visual Basic-Quellcode

    1. Public Sub subSpeichern2()
    2. Dim FSO As Object
    3. Dim strDateiname As String
    4. Dim strPfadname As String
    5. Dim WshShell As Object
    6. Dim strDokumente As String
    7. Set WshShell = CreateObject("WScript.Shell")
    8. Set FSO = CreateObject("Scripting.FileSystemObject")
    9. strDokumente = "C:\Users\User\Desktop\test"
    10. strPfadname = strDokumente
    11. strDateiname = "Bestandsmanagement.xlsm"
    12. Err.Clear
    13. On Error Resume Next
    14. ' Lokal speichern
    15. If FSO.FolderExists(strPfadname) Then
    16. Application.DisplayAlerts = False ' verhindert Meldung zum Überschreiben einer vorhandenen Datei
    17. Sheets("Bestandsmanagement").SaveAs Filename:=strPfadname & "\" & strDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
    18. Application.DisplayAlerts = True ' Meldungen wieder anzeigen
    19. If Err.Number <> 0 Then
    20. MsgBox "Fehler " & Err.Number & vbLf & Err.Description, vbCritical + vbOKOnly, "Fehler beim speichern"
    21. End If
    22. Else
    23. MsgBox strPfadname & vbLf & "Nicht vorhanden", vbCritical + vbOKOnly, "Fehler beim speichern"
    24. End If
    25. On Error GoTo 0
    26. Set FSO = Nothing
    27. Set WshShell = Nothing
    28. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()

    TeamBob schrieb:

    Sheets("Bestandsmanagement").SaveAs Filename:=strPfadname & "\" & strDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
    Es gibt keinen Parameter ConflictResolution, der in diesem Context gültig wäre.
    Lass den weg.

    TeamBob schrieb:

    wenn dieses Sheet schon exiiert, müsste dieses überschrieben werden.
    Das wird bei der von dir verwendeten Einstellung DisplayAlerts=False automatisch erfolgen.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo
    Also ich habe jetzt "ConflictResolution" weggelassen und es kommt auch keinerlei Fehlermeldung.
    Jedoch speichert er nicht nur das eine Sheet ab in der Datei, sondern die ganze Datei und alle Sheets darin.
    Woran liegt das ?


    Habe jetzt das ganze auch mal anders versucht, aber da bekomme ich immer die Fehlermeldung das er FehlerSheet,
    da er also das Sheet nicht erstellen oder laden kann.

    Visual Basic-Quellcode

    1. Public Sub subSpeichernSheet()
    2. Dim wbBestand As Workbook
    3. Dim wsTabelle As Worksheet
    4. Dim strDatei As String
    5. Dim strPfad As String
    6. On Error GoTo FehlerDatei
    7. ' Datei öffnen
    8. strPfad = "C:\Users\User\Desktop\test\"
    9. strDatei = "Bestandsmanagement.xlsx"
    10. Application.ScreenUpdating = False
    11. Set wbBestand = Workbooks.Open(Filename:=strPfad + strDatei, ReadOnly:=False, Editable:=True)
    12. On Error GoTo FehlerSheet
    13. If SheetExists("Bestandsmanagement", wbBestand) Then
    14. Set wsTabelle = wbBestand.Worksheets("Bestandsmanagement")
    15. Else
    16. Set wsTabelle = wbBestand.Worksheets.Add(after:=wbBestand.Sheets(wbBestand.Sheets.Count))
    17. wsTabelle.Name = "Bestandsmanagement"
    18. End If
    19. Sheets("Bestandsmanagement").SaveAs Filename:=strPfad & "\" & strDatei, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    20. On Error GoTo FehlerCell
    21. wbBestand.Close True ' Speichern
    22. GoTo ExitSub ' Ablauf OK, sub verlassen
    23. ' Fehler-Handling und Aufräumen der Variablen
    24. FehlerCell: ' Fehler beim Lesen eines Textfeldes oder Schreiben in eine Zelle
    25. 'wbCharge.Close False ' Datei schließen, nicht Speichern
    26. wbBestand.Close True ' Datei schließen, ZUM TESTEN Speichern
    27. MsgBox "Es konnten nicht alle Daten gespeichert werden"
    28. GoTo ExitSub
    29. FehlerSheet:
    30. wbBestand.Close False ' Datei schließen, nicht Speichern
    31. MsgBox "Fehler beim Laden oder Erzeugen des Tabellenblatts 'Bestandsmanagement'"
    32. GoTo ExitSub
    33. FehlerDatei: ' Fehler beim Öffnen oder Lesen der Datei. Sub verlassen
    34. MsgBox "Fehler beim Öffnen der Datei!"
    35. GoTo ExitSub
    36. ExitSub:
    37. On Error GoTo 0
    38. Set wsTabelle = Nothing
    39. Set wbBestand = Nothing
    40. Application.ScreenUpdating = True
    41. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()

    Dann mach's so:

    Visual Basic-Quellcode

    1. ​Worksheets("Tabelle1").Copy
    2. ActiveWorkbook.SaveAs ...
    3. ActiveWorkbook.Close False
    Da aber am besten ein Fehlerhandling einbauen, damit du dir nicht aus Versehen den Teppich unter den Füßen wegziehst.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Aber damit funktioniert es doch auch nicht ohne weiteres.
    Ich möchte das entsprechend Sheet aus der aktuelle Datei in eine andere Datei Speichern und das bestehende dort ersetzen.
    Dabei sollte nur das entsprechend Sheet kopiert werden und nicht die gesamte Datei.
    Irgendwie funktionieren meine Funtkionen oben nicht. Weist du wo der Fehler ist?

    Habe das mit deinen Befehl .Copy versucht, aber es kommt keinerlei Fehler, aber kopieren tut er das Sheet auch nicht.

    Visual Basic-Quellcode

    1. Public Sub subSpeichereBestand()
    2. Dim QWB As Workbook, ZWB As Workbook
    3. Dim QWS As Worksheet, ZWS As Worksheet
    4. Application.ScreenUpdating = False
    5. Application.EnableEvents = False
    6. Workbooks.Open "C:\Users\User\Desktop\test\Bestandsmanagement.xlsx" ' Pfad der Zieldatei
    7. Set QWB = Workbooks("Formatierung1") ' Quelldatei, welche offen ist und wo das Marko drin ist
    8. Set ZWB = Workbooks("Bestandsmanagement.xlsx") ' Zieldatei
    9. Set QWS = QWB.Worksheets("Bestandsmanagement") ' Sheet der Quelldatei
    10. 'Abfrage ob Sheet exisitert, falls nicht dann wird Sheet generiert
    11. If SheetExists("Formatierung1", ZWB) Then
    12. Set ZWS = ZWB.Worksheets("Formatierung1")
    13. Else
    14. Set ZWS = ZWB.Worksheets.Add(after:=ZWB.Sheets(ZWB.Sheets.Count))
    15. ZWS.Name = "Formatierung1"
    16. End If
    17. Application.DisplayAlerts = False
    18. QWS.Cells.Copy ZWS.Cells(1, 1) ' Inhalt in Ziel-Tabelle einfügen
    19. Workbooks("Bestandsmanagement.xlsx").Close
    20. Application.DisplayAlerts = True
    21. Application.EnableEvents = True
    22. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „TeamBob“ ()

    Also der Speicherbefehl hat soweit gut funktioniert, jedoch möchte ich dieses Speicherbefehl für einfache Netzwerk (ohne Server nur PC miteinander verbunden) anwenden. Das Sheet soll in eine Datei im freigegebenen Netzwerkpfad gespeichert werden.
    Optional hab ich den Befehl auch umgeschrieben als Ladebefehl für das Sheet.
    Leider bekomme ich jetzt immer beim Ausführen eine Meldung, dass Die Datei Verknüpfungen zu anderen Datenquellen enthält, welche Aktualsiert werden können. Wie kann man diese Meldung ausschalten bzw. gibt es beim Netzwerk noch einen anderen Trick?

    Visual Basic-Quellcode

    1. Public Sub subSpeicherBestandNetzwerk()
    2. Dim QWB As Workbook, ZWB As Workbook
    3. Dim QWS As Worksheet, ZWS As Worksheet
    4. Dim strPfadname As String
    5. Application.ScreenUpdating = False
    6. Application.EnableEvents = False
    7. Workbooks.Open "\\PSERVER\Produktionsnetz\Datenerfassung\Bestandsmanagement1.xlsx" ' Pfad der Zieldatei
    8. Set QWB = Workbooks("Formatierung1") ' Quelldatei
    9. Set ZWB = Workbooks("Bestandsmanagement1.xlsx") ' Ziel
    10. Set QWS = QWB.Worksheets("Bestandsmanagement") ' Sheet der Quelldatei
    11. 'Abfrage ob Sheet exisitert, falls nicht dann wird Sheet generiert
    12. If SheetExists("Formatierung1", ZWB) Then
    13. Set ZWS = ZWB.Worksheets("Formatierung1")
    14. Else
    15. Set ZWS = ZWB.Worksheets.Add(After:=ZWB.Sheets(ZWB.Sheets.Count))
    16. ZWS.Name = "Formatierung1"
    17. End If
    18. Application.DisplayAlerts = False
    19. QWS.Cells.Copy ZWS.Cells(1, 1) ' Inhalt in Ziel-Tabelle einfügen
    20. Workbooks("Bestandsmanagement1.xlsx").Close True
    21. Application.DisplayAlerts = True
    22. Application.EnableEvents = True
    23. End Sub




    Hier ein anderer Befehl welche meine komplette Arbeitsmappe im Netzwerk speichert, jedoch geht dies ja nicht für ein einzelnes Sheet.

    Visual Basic-Quellcode

    1. Public Sub subSpeichern()
    2. Dim FSO As Object
    3. Dim strDateiname As String
    4. Dim strPfadname As String
    5. Dim WshShell As Object
    6. Dim strDokumente As String
    7. Set WshShell = CreateObject("WScript.Shell")
    8. Set FSO = CreateObject("Scripting.FileSystemObject")
    9. 'strDokumente = WshShell.SpecialFolders("MyDocuments")
    10. strDokumente = "C:\Users\User\Desktop\test"
    11. strPfadname = strDokumente
    12. strDateiname = "Formatierung1.xlsm"
    13. ' Speichern auf Netzwerkpfad
    14. Err.Clear
    15. 'strPfadname = "\\192.168.2.15\public"
    16. strPfadname = "\\PSERVER\Produktionsnetz\Datenerfassung1"
    17. If FSO.FolderExists(strPfadname) Then
    18. Application.DisplayAlerts = False ' verhindert Meldung zum Überschreiben einer vorhandenen Datei
    19. ActiveWorkbook.SaveCopyAs Filename:=strPfadname & "\" & strDateiname
    20. Application.DisplayAlerts = True ' Meldungen wieder anzeigen
    21. If Err.Number <> 0 Then
    22. MsgBox "Fehler " & Err.Number & vbLf & Err.Description, vbCritical + vbOKOnly, "Fehler beim speichern"
    23. End If
    24. Else
    25. MsgBox "Netzwerkpfad nicht vorhanden" & vbCrLf & "Datei intern gespeichert", vbInformation + vbOKOnly, "Datei intern gespeichert"
    26. End If
    27. On Error GoTo 0
    28. Set FSO = Nothing
    29. Set WshShell = Nothing
    30. End Sub
    Was du betreibst, ist reine Onanie.
    Worksheet.Copy (ohne Parameter) erstellt eine neues Workbook mit der Kopie des Worksheet.
    Das brauchst du nur noch speichern.
    Wie du oben siehst, ist das ein Dreizeiler.

    Und beim Speichern kannst du auch einen UNC-Pfad angeben.
    Es bleibt also immer noch ein Dreizeiler.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --