einige Tabellenblätter einzeln speichern

Forumthread: einige Tabellenblätter einzeln speichern

21.05.2019 09:50:50

Alex

Hey,
ich habe mal wieder ein Problem mit einem Makro. Ich habe mit dem Rekorder mir ein Makro aufgenommen. Die Datei enthält einige Tabellenblätter und einige dieser sollen einzeln abgespeichert werden in einem anderen Ordner. Gerne so wie sie auch in der Datei benannt sind. Das Makro funktioniert zwar so weit, aber ich muss jedes mal den Dateityp bestätigen. Bei mehreren Tabellenblättern doch etwas lästig. Gibt es da eine Möglichkeit das zu umgehen?
Falls relevant: Ich nutze Office 2016
Code:

Sub SpeicherVersuch1000() ' SpeicherVersuch1000 Makro Sheets("Berlin").Select Sheets("Berlin").Copy ChDir "C:\Test" ActiveWorkbook.SaveAs Filename:="C:\Test\Berlin.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Burg").Select Sheets("Burg").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Burg.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Cottbus").Select Sheets("Cottbus").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Cottbus.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Dresden").Select Sheets("Dresden").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Dresden.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Erfurt").Select Sheets("Erfurt").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Erfurt.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Hamburg").Select Sheets("Hamburg").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Hamburg.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Hannover").Select Sheets("Hannover").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Hannover.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("M?nchen").Select Sheets("M?nchen").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\M?nchen.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("NDSMitteBremen").Select Sheets("NDSMitteBremen").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\NDSMitteBremen.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("NDSWest").Select Sheets("NDSWest").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\NDSWest.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Potsdam").Select Sheets("Potsdam").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Potsdam.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("RheinMainFranken").Select Sheets("RheinMainFranken").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\RheinMainFranken.xlsx", FileFormat _ :=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("RheinRuhr").Select Sheets("RheinRuhr").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\RheinRuhr.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Rostock").Select Sheets("Rostock").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Rostock.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Salzwedel").Select Sheets("Salzwedel").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Salzwedel.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Stendal").Select Sheets("Stendal").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Stendal.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("Stuttgart").Select Sheets("Stuttgart").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Stuttgart.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close ActiveWindow.ScrollWorkbookTabs Sheets:=4 Sheets("Westfalen").Select Sheets("Westfalen").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\Westfalen.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Sheets("WestfalenNord").Select Sheets("WestfalenNord").Copy ActiveWorkbook.SaveAs Filename:="C:\Test\WestfalenNord.xlsx", FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close End Sub

Vielen Dank :)
LG
Alex

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: einige Tabellenblätter einzeln speichern

21.05.2019 10:12:06

Nepumuk
AW: einige Tabellenblätter einzeln speichern

21.05.2019 10:57:43

Luschi

AW: einige Tabellenblätter einzeln speichern

21.05.2019 10:12:06

Nepumuk

Hallo Alex,
am Anfang deines Makros:
Application.DisplayAlerts = False
und am Ende wieder:
Application.DisplayAlerts = True
Gruß
Nepumuk

AW: einige Tabellenblätter einzeln speichern

21.05.2019 10:57:43

Luschi

Hallo Alex,
bei mir siht das Makro so aus:


Sub SpeicherVersuch1001()
' SpeicherVersuch1001 Luschi
Dim wbk As Workbook, wsk As Worksheet, _
vArr As Variant, sTabs As String, sPfad As string_
i As Integer
sPfad = "C:\Test\"
'alle Namen der Tabellenblätter, die weggeschrieben werden sollen
sTabs = "Berlin~Burg~Cottbus~Dreesden~Erfurt~Hamburg~Hannover"  'usw.
'Array, welches man in einer Schleife durchaufen kann
vArr = Split(sTabs, "~", -1, vbTextCompare)
Application.DisplayAlerts = False
For i = LBound(vArr) To UBound(vArr)
Set wsk = ThisWorkbook.Worksheets(vArr(i))
Set wbk = wsk.Copy
wbk.SaveAs Filename:=sPfad & vArr(i) & "xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wbk.Saved = True
wbkl.Close False
DoEvents
Next i
If VarType(vArr) >= 8200 Then
Erase vArr
End If
Application.DisplayAlerts = True
End Sub

Gruß von Luschi
aus klein-Paris

Beliebteste Forumthreads (12 Monate)

einige Tabellenblätter einzeln speichern

Forumthread: einige Tabellenblätter einzeln speichern

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread