Workbook speichern(aber nicht alle Tabellen)

[o0Julia0o]

hi,

ich möchte ein Workbook per VBA speichern. Aber nicht alle Tabellen. Geht das?


So wird das gesamte Workbook gespeichert(die Datei wird auch überschrieben, wenn bereits vorhanden, was auch gewünscht ist):

Code:

ActiveWorkbook.SaveCopyAs Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Tabelle1").Range("J1").Value & ".xlsm"

Wenn ich jetzt nur Tabelle1 und Tabelle3 speichern wollen würde, ginge das?
ActiveWorkbook.Path & "\" & Worksheets("Tabelle1").Range("J1").Value & ".xlsm" ergibt: Daten1.xlsm

Mein misslungender Versuch:

Code:

ThisWorkbook.Worksheets("Tabelle1").Copy
ActiveWorkbook.SaveCopyAs Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Tabelle1").Range("J1").Value & ".xlsm"

Hier wird zusätzlich zur bestehenden Datei eine MappeN geöffnet. Und Excel meldet, dass er die Datei "Daten1.xlsm" nicht zugreifen kann.

Julia :)

[mumpel]

Hallo!

Sub SaveSheets1()
 
 Dim varSheets As Variant
 
 varSheets = Array("Tabelle1", "Tabelle3")
 
 ThisWorkbook.Sheets(varSheets).Copy
 
 With ActiveWorkbook
      .SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\" & ThisWorkbook.Sheets("Tabelle2").Range("J1").Value, _
              FileFormat:=xlOpenXMLWorkbookMacroEnabled
      .Close
 End With
 
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Gruß, René

[schauan]

Halllöchen,

Excel kann nur entweder die ganze Mappe oder ausgewählte Blätter.

1) entferne nach dem Speichern als ... die unnötigen Blätter.
2) Markiere die Blätter, mach eine Kopie in eine neue Mappe und speichere dann.

[o0Julia0o]

Hallöchen und danke!

Excel kann nur entweder die ganze Mappe oder ausgewählte Blätter.

1) entferne nach dem Speichern als ...  die unnötigen Blätter.
2) Markiere die Blätter, mach eine Kopie in eine neue Mappe und speichere dann.

Mit der Methode von Mumpel scheint es doch auch mit mehreren ausgewählten Blättern zu gehen.

1) dann dauert der Prozess aber viel länger, da ich die Datei wieder öffnen muss(Verlängerung 1). Und dann noch einmal speichern muss(Verlängerung 2).
2) Das dauert doch auch länger als einfach nur zu speichern wie Mumpel es macht. Wobei wohl nur echt minimal. Werde ich parallel zu Mumpels Variante jetzt testen:
Den Namen habe ich auch in Tabelle1 in J1, das ist kein Problem(ansonsten könnte ich ihn ja auch per Variable holen):

Code:

Sub SpeichernSheets()
    Sheets(Array("Tabelle1", "Tabelle3")).Copy
    ActiveWorkbook.SaveCopyAs Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Tabelle1").Range("J1").Value ".xlsm"
ActiveWokbook.Close
End Sub

Doch es funktioniert nicht. Es kommt der gleiche Fehler wie zuvor. Es wird zusätzlich zur bestehenden Datei eine MappeN geöffnet. Und Excel meldet, dass er auf die Datei "Daten1.xlsm" nicht zugreifen kann.


Mumpel-Methode: So probiere ich es:

Sub SaveSheets1()

Dim Arbeitsort As String
Dim varSheets As Variant

varSheets = Array("Tabelle1", "Tabelle3")

ThisWorkbook.Sheets(varSheets).Copy

With ActiveWorkbook
     .SaveAs Filename: (Arbeitsort) &ThisWorkbook.Sheets("Tabelle1").Range("J1").Value, _
             FileFormat:=xlOpenXMLWorkbookMacroEnabled
     .Close
End With

End Sub

Es ist wichtig, dass die Datei, dort gespeichert wird, wo sich auch die Hauptdatei(in welcher der Code ausgeführt wird) befindet. Es werden zwar die richtigen Tabellen gespeichert. Doch die Datei wird dann ganz irgendwo anders gespeichert. Außerdem wird nachgefragt, ob die vorhandene Datei überschrieben werden soll. Das soll auch nicht sein. Geht das?

[mumpel]

Wenn die Datei geöffnet bleiben soll kannst Du ".Close" auch weglassen. "SaveCopyAs" speichert eine Kopie der aktiven Datei.

Sub SaveSheets1()
 
 Dim varSheets As Variant
 
 varSheets = Array("Tabelle1", "Tabelle3")
 
 ThisWorkbook.Sheets(varSheets).Copy
 
 Application.DisplayAlerts = False
 With ActiveWorkbook
      .SaveAs Filename:=ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Tabelle2").Range("J1").Value, _
              FileFormat:=xlOpenXMLWorkbookMacroEnabled
      '.Close 
 End With
 Application.DisplayAlerts = True
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

[schauan]

Hallo Julia,

Wenn Du die beiden Blätter kopiert hast brauchst Du nicht noch mal SaveCooyAs. Mit dieser Variante hast Du schon eine neue Datei und brauchst nur noch SaveAs.Ansonsten hast Du dann 2 neue Dateien...

[o0Julia0o]

Danke, dann kommt eine Fehlermeldung & die Zeilen 3 und 4 werden dabei gelb markiert: "Laufzeitfehler 438: Objekt unterstüzt diese Eigenschaft oder Methode nicht"

Code:

Sub SpeichernSheets()
    Sheets(Array("Tabelle1", "Tabelle3")).Copy
    ActiveWorkbook.SaveCopy Filename:= _
ActiveWorkbook.Path & "\" & Worksheets("Tabelle1").Range("J1").Value ".xlsm"
ActiveWokbook.Close
End Sub

[mumpel]

In Zeile 3 fehlt ein &. In Zeile 4 fehlt ein r. Nimm einfach meinen Code. Der ist eleganter und sollte funktionieren. Zudem muss man ab Office 2010 zwingend das FileFormat angeben.

[schauan]

Hallo Julia,

Ich hatte SaveAs geschrieben und nicht SaveCopy Im Prinzip als Erklärung zu René s und meinem Beitrag.

[mumpel]

Den Fehler in Zeile zwei habe ich doch glatt übersehen. ;) (Den Coderumpf zähle ich jetzt mal nicht als Codezeile mit)