Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1680to1684
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

Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen

Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 14:12:19
Denis
Guten Tag liebes Forum!
Ich suche eine Lösung, um das Aktive Arbeitsblatt als eigene Datei zu speichern mit dem Dateinamen 'Dateiname' + 'Arbeitsblattnamen', also nicht genau die Wörter, sondern je nach Datei andere Dateinamen und Arbeitsblattnamen.
Die alte Datei sollte dabei erhalten bleiben.
Zum Beispiel:
Die Beispieldatei heißt "Rechnungsübersicht" und in der Datei wird das Arbeitsblatt "12345678" angeklickt. Nun soll das Makro ausgeführt werden und in einem Ordner soll nun die neue Datei "Rechnungsübersicht - 12345678" erscheinen, in der nur ein Arbeitsblatt enthalten ist, nämlich das eine Arbeitsblatt 12345678.
Und das Makro soll universell mit eigentlich allen Exceldateien funktionieren.
Meine größte Schwierigkeit war der Part mit dem Dateinamen + Arbeitsblattnamen hinzubekommen.
Ich hoffe, dass mir jemand helfen kann.
Gruß
Denis

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 14:30:00
Torsten
Hallo,
z. B. so:

Sub EinzelnesBlattSpeichern()
Dim wbAkt As Workbook, wbNeu As Workbook
Dim Pfad as String, wsAkt as String
Pfad = "Dein Pfad"
wsAkt = Activesheet.Name
Set wbAkt = AktiveWorkbook.Name
Set wbNeu = wbAkt.ActiveSheet.Copy
wbNeu.SaveAs Pfad & "\" & wsAkt & ".xls"
wbNeu.Close 'Neue Datei wird geschlossen
End Sub
Gruss Torsten
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 14:32:57
Torsten
Sorry, Dateiendung muss natuerlich ".xlsx" sein. Du hast ja Office 365.
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 15:29:13
Denis
Hallo Torsten,
danke für die schnelle Antwort!
Bei der Zeile
"Set wbAkt = AktiveWorkbook.Name"
erscheint der Fehler "Laufzeitfehler'424': Objekt erforderlich".
Weißt du was es damit auf sich hat?
Gruß
Denis
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 17:01:24
cysu11
Hi Dennis,
probiere das mal so:
Sub eigene()
Dim strDateiname As String
Dim strPfad As String
strPfad = Environ$("USERPROFILE") & "\" & "Desktop\"
'strDateiname = ThisWorkbook.Name & " - " & ActiveSheet.Name
strDateiname = Application.Substitute(ActiveWorkbook.Name, ".xlsm", "") _
& " - " & ActiveSheet.Name
ActiveSheet.Copy 'Kopiert nur das AKTUELLE Blatt in eine neue Datei !
ActiveWorkbook.SaveAs Filename:=strPfad & strDateiname, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
End Sub
Das ".xlsm" musst du natürlich noch anpassen, je nachdem welche Dateiendung du hast!
LG
Alexandra
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 18:37:20
Denis
Vielen Dank Alexandra!
Ich nutze nun dein Makro, funktioniert super.
Vielen Danke auch an die Anderen die mir geholfen haben.
Viele Grüße
Denis
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 17:19:05
Karl-Heinz
Hi Denis,
muss so heißen:
Set wbAkt = ActiveWorkbook.Name
viele Grüße
Karl-Heinz
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
25.03.2019 18:34:01
Denis
Hi Karl-Heinz,
danke für den Hinweis!
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
26.03.2019 08:52:58
Marco
Hallo Denis,
ich habe ein ähnliches Makro schon im Einsatz. Du kannst es jeweils auf die aktive Arbeitsmappe und das ausgewählte Blatt anwenden. (Bei mir habe ich es z.B. in meine PERSONAL.XLSB eingebaut um es jederzeit aufrufen zu können).
Ich habe hier ein paar kleine Anpassungen gemacht, so dass es für Deine Vorgaben passt und glaube es ist ganz verständlich kommentiert.
VG
Marco
Public Sub Dateispeichern()
Dim Speicherpfad As String
Dim Dateiname As String
Dim Arbeitsblatt As String
Dim SpeichernUnter As String
'Pfad unter der die offene Datei aktuell gespeichert ist
Speicherpfad = ActiveWorkbook.Path
'Dateiname der offenen Datei
Dateiname = ActiveWorkbook.Name
'Entfernung der Dateierweiterungen
Dateiname = VBA.Left(Dateiname, VBA.InStr(1, Dateiname, ".") - 1)
'Name des aktivierten Arbeitsblattes
Arbeitsblatt = ActiveSheet.Name
'Erstellung des neuen Speicherpfades
SpeichernUnter = Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xls"
'Aktives Arbeitsblatt in neue Datei kopieren
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
'Arbeitsblatt umbenennen in alten Namen
ActiveSheet.Name = Arbeitsblatt
'Aktives Worksheet in eigene Datei speichern und schliessen
ActiveWorkbook.SaveAs Filename:=SpeichernUnter, FileFormat:=xlExcel8
ActiveWorkbook.Close
End Sub

Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
26.03.2019 15:33:22
Denis
Hi Marco,
vielen Dank für deine Hilfe!
Ich habe das Makro noch etwas erweitert.
Falls der Dateiname bereits vergeben ist, dann kann man manuell den Namen ändern.
Bis auf das "Grundgerüst" von der i = MsgBox Schleife, stammt das Meiste von mir.
Hat jemand noch Verbesserungsvorschläge und hat die Methode mit den vielen "GoTo" Verwendungen irgendwelche Nachteile?
Ich bin schließlich noch Anfänger. Für jeden Tipp bin ich Dankbar!
Public Sub Dateispeichern()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Speicherpfad As String
Dim Dateiname As String
Dim Arbeitsblatt As String
Dim SpeichernUnter As String
On Error GoTo NamenAendern
'Pfad unter der die offene Datei aktuell gespeichert ist
Speicherpfad = ActiveWorkbook.Path
'Dateiname der offenen Datei
Dateiname = ActiveWorkbook.Name
'Entfernung der Dateierweiterungen
Dateiname = VBA.Left(Dateiname, VBA.InStr(1, Dateiname, ".") - 1)
'Name des aktivierten Arbeitsblattes
Arbeitsblatt = ActiveSheet.Name
'Erstellung des neuen Speicherpfades
SpeichernUnter = Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xlsm"
'Aktives Arbeitsblatt in neue Datei kopieren
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
'Arbeitsblatt umbenennen in alten Namen
ActiveSheet.Name = Arbeitsblatt
'Aktives Worksheet in eigene Datei speichern und schliessen
ActiveWorkbook.SaveAs Filename:=SpeichernUnter, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
GoTo Ending
NamenAendern:
Application.CutCopyMode = False
i = MsgBox("Neuen Namen auswählen? dann OK" & Chr(13) & _
"" & Chr(13) & _
"Sonst Abbrechen" & Chr(13), 1 + vbQuestion, "Neuer Name")
If i = 2 Then GoTo Fehler
Dim Name
Name = Application.GetSaveAsFilename(Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & _
"(1)" & ".xlsm", fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsm), *.xlsm")  'Pfad evtl. anpassen!
If Name  False Then
ActiveWorkbook.SaveAs Name, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else: GoTo Fehler
End If
ActiveWorkbook.Close
GoTo Ending
Fehler:
ActiveWorkbook.Close SaveChanges:=False
MsgBox "Die Datei wurde nicht gespeichert", vbExclamation
Ending:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Viele Grüße
Denis
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
26.03.2019 17:27:34
Denis
Hi,
mir ist gerade ein Problem aufgefallen, was ich mir nicht erklären kann.
Ich habe bisher das Makro immer bei einer Testdatei laufen lassen und da lief das wunderbar, nun allerdings bei einer anderen Datei tritt ein Fehler auf.
In der Zeile:
ActiveSheet.Select erscheint der Fehler:
"Laufzeitfehler'1004': Anwendungs- oder objektdefinierter Fehler"
Hier zum gesamten Makro:
Public Sub Blatt_Als_Neue_Datei_speichern()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Speicherpfad As String
Dim Dateiname As String
Dim Arbeitsblatt As String
Dim SpeichernUnter As String
'On Error GoTo NamenAendern
Speicherpfad = ActiveWorkbook.Path  'Pfad evtl. anpassen
Dateiname = ActiveWorkbook.Name
Dateiname = VBA.Left(Dateiname, VBA.InStr(1, Dateiname, ".") - 1)
Arbeitsblatt = ActiveSheet.Name
SpeichernUnter = Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xlsm"
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.Name = Arbeitsblatt
ActiveWorkbook.SaveAs Filename:=SpeichernUnter, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
GoTo Ending
NamenAendern:
Application.CutCopyMode = False
i = MsgBox("Neuen Namen auswählen? dann OK" & Chr(13) & _
"" & Chr(13) & _
"Sonst Abbrechen" & Chr(13), 1 + vbQuestion, "Neuer Name")
If i = 2 Then GoTo Fehler
Dim Name
Name = Application.GetSaveAsFilename(Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & _
"(1)" & ".xlsm", fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsm), *.xlsm")  'Pfad evtl. anpassen!
If Name  False Then
ActiveWorkbook.SaveAs Name, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else: GoTo Fehler
End If
ActiveWorkbook.Close
GoTo Ending
Fehler:
ActiveWorkbook.Close SaveChanges:=False
MsgBox "Die Datei wurde nicht gespeichert", vbExclamation
Ending:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hoffentlich kann mir jemand helfen
Gruß
Denis
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
26.03.2019 17:53:22
Denis
Hi,
ich bin dem Problem, dass ich bereits oben erläutert habe, etwas näher gekommen.
Ich habe vorhin eine Personal.xlsb Datei nach einer Anleitung angelegt und dort das Makro reinkopiert, damit ich das Makro von allen Arbeitsmappen öffnen kann, hat aber nicht wie gewünscht funktioniert, da die Personal.xlsb sich nun beim Start immer öffnet.
Ich habe also das Makro aus der Personal.xlsb Datei aus, in einer anderen Datei ausgeführt und in dem Fall entsteht der Fehler.
Also wär der Fehler evtl. gelöst, wenn ich es vernümftig hinbekomme, das Makro in allen Dateien verwenden zu können.
Wenn jemand weiß wie das geht und mir dieses Wissen mitteilt, wäre ich sehr dankbar.
Kann auch gut sein, dass ich falsch liege und der Fehler auch noch mit etwas anderem zusammenhängt.
Gruß
Denis
Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
27.03.2019 07:59:08
Marco
Hallo Denis,
ich bin leider nur Tagsüber im Büro und kann es mir daher erst meistens am nächsten Tag anschauen.
Das Problem, das ich in diesem Fall nicht bedacht habe, ist dass er natürlich wenn die Datei noch nicht existiert und gespeichert ist keine Dateierweiterung hat die er entfernen kann.
Dazu ist kein Speicherpfad bekannt. Den muss man daher auch festlegen.
Ich habe die Änderung markiert, damit Du nur den Teil ändern müsstest.
Klar kann man das noch eleganter lösen indem man ggf. den Speicherpfad auswählen lässt.
Deine anderen Anpassungen waren soweit glaube ich ok - habe es aus Zeitgründen nicht getestet.
VG
Marco
Public Sub AktiveMappespeichern()
Dim Speicherpfad As String
Dim Dateiname As String
Dim Arbeitsblatt As String
Dim SpeichernUnter As String
'Pfad unter der die offene Datei aktuell gespeichert ist
Speicherpfad = ActiveWorkbook.Path
'Dateiname der offenen Datei
Dateiname = ActiveWorkbook.name
'*** Änderung start
'Entfernung der Dateierweiterungen
If Speicherpfad  "" Then
Dateiname = VBA.Left(Dateiname, VBA.InStr(1, Dateiname, ".") - 1)
Else
Speicherpfad = "H:"
End If
'*** Änderung Ende
'Name des aktivierten Arbeitsblattes
Arbeitsblatt = ActiveSheet.name
'Erstellung des neuen Speicherpfades
SpeichernUnter = Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xls"
'Aktives Arbeitsblatt in neue Datei kopieren
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
'Arbeitsblatt umbenennen in alten Namen
ActiveSheet.name = Arbeitsblatt
'Aktives Worksheet in eigene Datei speichern und schliessen
ActiveWorkbook.SaveAs Filename:=SpeichernUnter, FileFormat:=xlExcel8
ActiveWorkbook.Close
End Sub

Anzeige
AW: Arbeitsblatt SaveAs Dateinamen+Arbeitsblattnamen
29.03.2019 15:23:01
Denis
Hi,
ich hab nun das Makro Projekt abgeschlossen.
Wenn ihr trotzdem noch Tipps habt, dann gerne her damit, ich muss noch viel lernen.
Danke nochmal an alle die geholfen haben.
Hier ist das fertige Makro, dass in Zukunft verwendet wird.
Nur wenn der Nutzer des Makros dreimal versucht unter einem bereits verwendeten Namen zu speichern, kommt es zur Unterbrechung, ansonsten sind mir keine Möglichkeiten bekannt wie das Makro scheitern kann.
Public Sub Blatt_Als_Neue_Datei_speichern()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Speicherpfad As String
Dim Dateiname As String
Dim Arbeitsblatt As String
Dim SpeichernUnter As String
Speicherpfad = ActiveWorkbook.Path
Dateiname = ActiveWorkbook.Name
Dateiname = VBA.Left(Dateiname, VBA.InStr(1, Dateiname, ".") - 1)
Arbeitsblatt = ActiveSheet.Name
If Dir(Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xlsm")  "" Then
On Error GoTo NamenAendern
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.Name = Arbeitsblatt
Application.CutCopyMode = False
i = MsgBox("   Neuen Namen auswählen?" & Chr(13) & _
"" & Chr(13) & _
"   Sonst Abbrechen" & Chr(13), 1 + vbQuestion, "Name bereits vorhanden")
If i = 2 Then GoTo FehlerEnding
Dim Name
Name = Application.GetSaveAsFilename(Speicherpfad & "\" & Dateiname & " - " &  _
Arbeitsblatt & "(1)" & ".xlsm", fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsm), *.xlsm")  'Pfad evtl. anpassen!
If Name  False Then
ActiveWorkbook.SaveAs Name, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else: GoTo FehlerEnding
End If
ActiveWorkbook.Close
GoTo Ending
Else:
SpeichernUnter = Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt & ".xlsm"
ActiveSheet.Select
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveSheet.Name = Arbeitsblatt
ActiveWorkbook.SaveAs Filename:=SpeichernUnter, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close
GoTo Ending
End If
NamenAendern:
Application.CutCopyMode = False
i = MsgBox("Anderen Namen auswählen" & Chr(13) & _
"" & Chr(13) & _
"Sonst Abbrechen" & Chr(13), 1 + vbExclamation, "Name bereits vorhanden")
If i = 2 Then GoTo FehlerEnding
Dim Name2
Name2 = Application.GetSaveAsFilename(Speicherpfad & "\" & Dateiname & " - " & Arbeitsblatt  _
& "(2)" & ".xlsm", fileFilter:="Microsoft Excel-Arbeitsmappe (*.xlsm), *.xlsm")  'Pfad evtl. anpassen!
If Name2  False Then
ActiveWorkbook.SaveAs Name2, FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else: GoTo FehlerEnding
End If
ActiveWorkbook.Close
GoTo Ending
FehlerEnding:
ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Die Datei konnte nicht gespeichert werden", vbExclamation
Exit Sub
Ending:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Die Datei wurde erfolgreich gespeichert", vbInformation
End Sub

Viele Grüße
Denis
Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige