Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1548to1552
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

Tabs speichern Schleife (Speicherzielabfrage)

Tabs speichern Schleife (Speicherzielabfrage)
24.03.2017 13:20:36
Jupp
Hallo,
kann man den folgenden Code so umschreiben, dass sich eine Abfrage öffnet, die nach dem Zielordner fragt, also wo die Dateien gespeichert werden sollen?
_____________________________________________________________________________
Option Explicit
Const Pfad = "Pfad"
_____________________________________________________________________________
Sub Blätter_einzeln_speichern()
Dim i As Integer, Speichername As String
Application.ScreenUpdating = False
Rem: Schleife um jedes Tabellenblatt anzusprechen
Rem: Schleife läuft von hinten nach vorne
For i = Worksheets.Count To 2 Step -1
Rem: Blattname in Variable "Speichername" schreiben
Speichername = ThisWorkbook.Sheets(i).Name
Rem: Das durch die Schleife angesprochene Tabellenblatt in eine neue Datei verschieben
Sheets(i).Move
Rem: Datei mit dem verschobenen Tabellenblatt unter dem Namen, der in Variable "Speichername"
Rem: gespeichert wurde abspeichern
ActiveWorkbook.SaveAs Filename:=Pfad & Speichername & ".xls"
Rem: Abgespeicherte Datei schließen
ActiveWindow.Close
Next
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabs speichern Schleife (Speicherzielabfrage)
24.03.2017 21:04:49
Ur-Opa
Hallo Jupp,
nachfolgend eine mögliche Lösung.
Am Besten, Du schaust es Dir einmal Schritt für Schritt an.
Option Explicit
Sub Blaetter_einzeln_speichern()
Dim iIndex As Integer, _
sPfad As String, _
sDateiname As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Verarbeitung abgebrochen", vbCritical
Exit Sub
End If
sPfad = .SelectedItems(1)
End With
For iIndex = ThisWorkbook.Sheets.Count To 2 Step -1
sDateiname = sPfad + "\" + ThisWorkbook.Sheets(iIndex).Name + ".xls"
Sheets(iIndex).Move
ActiveWorkbook.SaveAs Filename:=sDateiname
ActiveWindow.Close
Next
End Sub

Viel Erfolg
Ur-Opa
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige