Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1808to1812
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1808to1812
1808to1812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Über Makro direkt speichern

Über Makro direkt speichern
08.02.2021 20:16:25
edi
Hallo Zusammen,
brauche bitte eure Hilfe..
ich möchte gerne über Makro, dass eins von mehreren Tabellenblätter per Klick direkt an meinen gewünschten Ordner bzw. Ort gespeichert wird, jedoch mich noch einmal fragt, ob die vorhandene Datei überschreiben soll oder nicht.
Dabei habe ich so angefangen....
Sub Tabellenblatt_Speichern()
ActiveSheet.Copy
Application.Dialogs(xlDialogSaveAs).Show ActiveSheet.Name
End Sub

nun weiß ich nicht weiter..
Viele Grüße
Edi

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

Betreff
Datum
Anwender
Anzeige
AW: Über Makro direkt speichern
08.02.2021 20:36:38
ralf_b
Wie wäre es damit? 
Sub Tabellenblatt_Speichern()
Dim bSave As Boolean
Dim sFilename As String
sFilename = "F:\excel\testf.xls"
ActiveSheet.Copy
If Dir(sFilename) = "" Then 'existiert datei?
bSave = True
Else
If vbYes = MsgBox("Datei vorhanden! Überschreiben?", vbYesNo) Then 'Abfrage ob gelöscht und  _
neue datei gespeichert werden soll
bSave = True
On Error Resume Next
Workbooks(sFilename).Close Savechanges:=False 'datei schließen falls offen
Kill sFilename 'dann löschen
Else
bSave = False
End If
End If
Application.DisplayAlerts = False
If bSave Then Application.ActiveWorkbook.SaveAs filename:=sFilename ' datei speichern
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Über Makro direkt speichern
08.02.2021 20:55:06
edi
Hallo Ralf_b
danke für deine Hilfe habe das eingefügt und bei sFilename = "F:\excel\testf.xls" den Ort eingeben. Jetzt wird die Datei nur geöffnet unter anderem Namen und nicht mit dem Namen des Tabellenblatts.
Gruß
AW: Über Makro direkt speichern
08.02.2021 22:28:04
ralf_b
hallo, durch das ActiveSheet.Copy wir eine neue Mappe mit dem Blatt darin erzeugt. Der Name ist vom System vorgegeben. Der Dateiname wird beim speichern vergeben.
z.B. 

Dim sFilename As String
Dim sTabname as String  'neu
sTabname = ActiveSheet.Name 'neu
sFilename = "F:\excel\" & sTabname  & ".xlsx"  'anpassen
ActiveSheet.Copy

Anzeige
AW: Über Makro direkt speichern
09.02.2021 18:36:09
edi
Hallo Ralf_b,
leider komme ich nicht weiter. Der öffnen mit die Datei mit dem richtigen Namen aber speichert die nicht ab. Wo gebe ich den Ort ein wo die Datei gespeichert werden soll?
Viele Grüße
AW: Über Makro direkt speichern
09.02.2021 21:16:34
ralf_b
ok, dann wieder zurück zu einem Dialog.
Ich hatte dich so verstanden das die neue Datei den Namen des Arbeitsblattes erhält.
Zum Pfad hatte ich im Code einen Kommentar hinterlegt "'anpassen" das war eine Info für dich.
Woher soll ich denn wissen wohin du speichern willst?
Entweder du legst das irgendwo fest oder du machst das über eine Eingabemöglichkeit. Die Exceldialoge bieten schon eine komfortable Möglichkeit aber eben dann für die ganze Datei. Vielleicht wäre da eine Komnbination beider Varianten möglich. Hier mein letzter Versuch. 
Sub Tabellenblatt_Speichern()
Dim bSave As Boolean
Dim sFilename As String
Dim sTabname As String  'neu
Dim sFullPath As String
Dim sFolder As String
Dim wbAKt As Workbook
Set wbAKt = ActiveWorkbook
sTabname = ActiveSheet.Name 'neu
sFilename = sTabname & ".xlsx"    'anpassen
With Application.FileDialog(msoFileDialogFolderPicker) 'ordnerauswahl
.InitialFileName = ActiveWorkbook.Path
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1) & Application.PathSeparator
Else
sFolder = ActiveWorkbook.Path & Application.PathSeparator
End If
End With
ActiveSheet.Copy 'neue Datei mit Arbeitsblatt erzeugen
sFullPath = sFolder & sFilename 'dateiname und pfad
If Dir(sFullPath) = "" Then 'existiert datei?
bSave = True
On Error Resume Next
Workbooks(sFilename).Close Savechanges:=False 'datei schließen falls offen
Else
If vbYes = MsgBox("Datei vorhanden! Überschreiben?", vbYesNo) Then 'Abfrage ob gelöscht  _
und _
' neue datei  _
gespeichert werden soll
bSave = True
On Error Resume Next
Workbooks(sFilename).Close Savechanges:=False 'datei schließen falls offen
Kill sFullPath 'dann löschen
Else
bSave = False
End If
End If
Application.DisplayAlerts = False
If bSave Then Application.ActiveWorkbook.SaveAs Filename:=sFullPath ' datei speichern
Application.Workbooks(sFilename).Close Savechanges:=False
wbAKt.Activate
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Über Makro direkt speichern
10.02.2021 19:50:24
edi
Hallo Ralf_b,
vielen dank für deine Hilfe. Leider funktioniert es nicht. Ich habe das gemacht was du mir gesagt hast.
Sub Tabellenblatt_Speichern()
Dim bSave As Boolean
Dim sFilename As String
Dim sTabname As String  'neu
Dim sFullPath As String
Dim sFolder As String
Dim wbAKt As Workbook
Set wbAKt = ActiveWorkbook
sTabname = ActiveSheet.Name 'neu
sFilename = sTabname[sTabname ERSETZT DURCH DATEINAMEN] & ".xlsx"    'anpassen
With Application.FileDialog(msoFileDialogFolderPicker) 'ordnerauswahl
.InitialFileName = ActiveWorkbook.Path
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1) & Application.PathSeparator
Else
sFolder = ActiveWorkbook.Path & Application.PathSeparator
End If
End With
ActiveSheet.Copy 'neue Datei mit Arbeitsblatt erzeugen
sFullPath = sFolder [sFolder ERSETZT DURCH DATEINAMEN] & sFilename [sfilename ERSETZT DURCH  _
_
SPEICHERORT]  'dateiname und pfad
If Dir(sFullPath) = "" Then 'existiert datei?
bSave = True
On Error Resume Next
Workbooks(sFilename).Close Savechanges:=False 'datei schließen falls offen
Else
If vbYes = MsgBox("Datei vorhanden! Überschreiben?", vbYesNo) Then 'Abfrage ob gelöscht   _
_
_
und _
' neue datei  _
gespeichert werden soll
bSave = True
On Error Resume Next
Workbooks(sFilename).Close Savechanges:=False 'datei schließen falls offen
Kill sFullPath 'dann löschen
Else
bSave = False
End If
End If
Application.DisplayAlerts = False
If bSave Then Application.ActiveWorkbook.SaveAs Filename:=sFullPath ' datei speichern
Application.Workbooks(sFilename).Close Savechanges:=False
wbAKt.Activate
Application.DisplayAlerts = True
End Sub

Anzeige
AW: Über Makro direkt speichern
10.02.2021 20:16:32
ralf_b
Was ist denn das "Es" was nicht funktioniert?
eine Sache konnte ich ausmachen.
hast du tatsächlich den Dateinamen vor den Pfad gesetzt?
im Grunde ist der Dateipfad ja alles beides zusammen. Aber vorne kommt der Ordner(folder) pfad und am Ende der Dateiname mit der Endung. 
sFullPath = sFolder [sFolder ERSETZT DURCH DATEINAMEN] & sFilename [sfilename ERSETZT DURCH  _
_
SPEICHERORT]
gruß
rb
AW: Über Makro direkt speichern
08.02.2021 20:40:21
PeTeR
Hi Edi,
evtl. auch so:
Dim Pfad As String
Dim TabNAme As String
Application.DisplayAlerts = False
Pfad = ThisWorkbook.Path
TabNAme = ActiveSheet.Name
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Pfad & "\" & TabNAme & ".xlsx"
Application.DisplayAlerts = True
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige