Tabelle in neue Mappe mit schleife

Sub Blätter_einzeln_speichern() Dim i As Integer, Speichername As String Const Pfad = "blabla" Application.ScreenUpdating = False Rem: Schleife um jedes Tabellenblatt anzusprechen Rem: Schleife läuft von hinten nach vorne For i = Worksheets.Count To 5 Step -1 Rem: Blattname in Variable "Speichername" schreiben Speichername = ThisWorkbook.Sheets(i).Name Rem: Das durch die Schleife agesprochene Tabellenblatt in eine neue Datei verschieben Sheets(i).Move after Rem: Datei mit dem verschobenen Tabellenblatt unter dem Namen, der in Variable "Speichername" Rem: gespeichert wurde abspeichern ActiveWorkbook.SaveAs Filename:=Pfad & "test sonntag" & ".xlsx" Rem: Abgespeicherte Datei schließen ActiveWindow.Close Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Einzelne_Tab_Speichern() ' speichert die Tabellen der aktiven Datei ' (ausser die ersten vier) einzeln als Datei Dim Pfad As String Pfad = "D:\Documents\0000_TEST2" & "\" Application.ScreenUpdating = False ActiveWorkbook.Save For i = Worksheets.Count To 5 Step -1 ThisWorkbook.Sheets(i).Copy ActiveWorkbook.SaveAs Pfad & ThisWorkbook.Sheets(i).Name & ".xlsx" ActiveWorkbook.Close Next Application.ScreenUpdating = True End Sub

Hallo Martin
Da hab ich Dich gestern ganz falsch verstanden. - Hier ein anderes Makro. Die aktive Datei wird unter einem neuen Namen gespeichert. Die ersten vier Tabellen der Originaldatei werden dabei nicht in die neue Datei übernommen.
Im Makro musst Du Pfad und Name der neuen Datei erfassen - den neuen Dateinamen ohne Erweiterung! Die Erweiterung wird von der Originaldatei übernommen. - Am Ende sind beide Dateien geöffnet. Aktiviert ist die neu erstellte.
Die Fehlermeldung ganz am Ende habe ich vor allem für mich gemacht: Wenn ich beim öfteren Testen vergesse, die bereits vorhandene neue Datei zu schliessen, kommt es zum Laufzeitfehler 1004.
Ich hoffe, das hilft Dir. Grüsse Niclaus

Sub m2aaa()
Dim Pfad As String, NeuDatei As String, AltDatei As String, DatExt As String
Dim i As Integer
On Error GoTo fehler1
Rem: Pfad und Dateiname (NeuDatei) der neuen Datei muessen hier bestimmt werden!
Rem: Der Dateiname ohne Erweiterung! Diese entspricht der Erweiterung der Originaldatei.
Pfad = "D:\Documents\0000_TEST2" & "\"
NeuDatei = "ReduzierteDatei"  'Ohne Erweiterung!!
ActiveWorkbook.Save
AltDatei = ActiveWorkbook.FullName
DatExt = "." & Mid(AltDatei, InStrRev(AltDatei, ".") + 1)
ActiveWorkbook.SaveAs Filename:=Pfad & NeuDatei & DatExt
Application.DisplayAlerts = False
' Die Tabellen werden ohne Rueckfrage geloescht!
For i = 4 To 1 Step -1
Sheets(i).Delete
Next
Rem: Variante statt For-Schleife
'Sheets(Array(1, 2, 3, 4)).Select
'ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Save
Workbooks.Open Filename:=AltDatei
Windows(NeuDatei & DatExt).Activate
Exit Sub
fehler1:
MsgBox "Ist die neue Datei etwa bereits geoeffnet?"
End Sub

Beliebteste Forumthreads (12 Monate)

Tabelle in neue Mappe mit schleife

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabelle in neue Mappe mit schleife

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread