Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
708to712
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
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA alle Register 1 Mappe als jeweils neue Datei

VBA alle Register 1 Mappe als jeweils neue Datei
19.12.2005 10:34:47
Horst
Hallo Leute im Forum,
Wer kann mir mein script anpassen, damit alle Register einzelne Dateien werden, benannt nach der jeweiligen Registerbezeichnung? Alle Register haben gleichen Aufbau. Der Dateiname sollte bestehen aus folgender Reihenfolge:
1. "Text" (wird einmalig im VBA festgelegt
2. Zelleinhalt von N3
3. akt. Datum + Zeit
Danke für eure Hilfe! Gruß Horst

Sub Tab_Blatt_Speichern43()
Dim strPfad As String
Dim strDateiname As String
Application.ScreenUpdating = False
strPfad = "C:\Programm QSB\dat_Ziel\"
'?    strDateiname = "Auszug Jahr Filter " & Format(Now(), "yyyy mm dd  hh-mm")
ActiveSheet.Copy
ActiveWorkbook.SaveCopyAs (strPfad & strDateiname & ".XLS")
'    ActiveWorkbook.Close savechanges:=False
' entfällt Msgbox "Das Blatt wurde unter " & strPfad & strDateiname & " gespeichert!"
Application.ScreenUpdating = True
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA alle Register 1 Mappe als jeweils neue Datei
19.12.2005 11:57:39
Heiko
Hallo Horst,
z.B. so:

Sub SheetsSpeichern()
Dim strPfad As String, strNewBook As String
Dim strDateiname As String
Dim wks As Worksheet
Application.ScreenUpdating = False
strPfad = "C:\Programm QSB\dat_Ziel\"
For Each wks In ActiveWorkbook.Worksheets
strDateiname = "Auszug Jahr Filter " & wks.Range("N3").Text & " " & Format(Now(), "yyyy mm dd  hh-mm")
Application.StatusBar = strDateiname
Workbooks.Add 1
strNewBook = ActiveWorkbook.Name
wks.Copy Before:=Workbooks(strNewBook).Sheets(1)
Application.DisplayAlerts = False
Workbooks(strNewBook).Sheets(2).Delete
Application.DisplayAlerts = True
Workbooks(strNewBook).SaveAs (strPfad & strDateiname & ".XLS")
Workbooks(strDateiname).Close
Next wks
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
AW: VBA alle Register 1 Mappe als jeweils neue Datei
19.12.2005 12:58:17
Horst
Hallo Heiko,
danke. Klappt recht gut - jedoch wird immer die gleiche Datei überschrieben, weil die Bezeichnung des Registers im Dateinamen fehlt. Könntest du bitte dahingehend noch einmal
strDateiname = "Auszug Jahr Filter " & wks.Range("N3").Text & " " & Format(Now(), "yyyy mm dd hh-mm")
ändern? Dann würde ich genau das Ergebnis haben. Wäre prima!
Gruß
Horst
AW: VBA alle Register 1 Mappe als jeweils neue Datei
19.12.2005 13:14:55
Heiko
Hallo Horst,
recht gut ?! Klingt irgendwie nach Glas halb leer, statt Glas halb voll. Werde versuchen in Zukunft auch deine Gedanken zu lesen, um deine Aufgabestellung auf Anhieb zu erfüllen ;-)
Vielleicht so :
strDateiname = "Auszug Jahr Filter " & wks.Name & " " & wks.Range("N3").Text & " " & Format(Now(), "yyyy mm dd hh-mm")
Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige
AW: VBA alle Register 1 Mappe als jeweils neue Datei
19.12.2005 13:36:01
Horst
Hallo Heiko,
bitte nicht missverstehen. Jetzt läuft das script von dir mega super - bin ja dankbar, dass es im Forum Menschen wie dich gibt, die behilflich sind!! Wünsche eine angenehme Weihnachtszeit!
Gruß
Horst

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige