Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1692to1696
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

einige Tabellenblätter einzeln speichern

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
Anzeige
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
Anzeige

312 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige