Public bolAbfrage As Boolean
Sub Daten_exportieren()
Dim FileName As Variant
Dim Pfad As String
Dim FileExtension As String
If Not bolAbfrage Then
FileName = Application.GetSaveAsFilename("Bulkupload_otimiert.xls")
If FileName <> False Then
Pfad = GetFullPath(FileName)
FileExtension = GetFileExtension(FileName)
bolAbfrage = True
Else
Exit Sub
End If
End If
For i = 1 To ActiveWorkbook.Sheets.Count
Blatti = Sheets(i).Name
Sheets(i).Copy
ActiveWorkbook.SaveAs Pfad & ThisWorkbook.Name & "-" & Blatti & FileExtension
auch immer deine Datei heißen soll.
ActiveWorkbook.Close
Next i
MsgBox "Dateien wurden erfolgreich erstellt und gespeichert!"
bolAbfrage = False
End Sub
Public Function GetFileExtension(ByVal FullPath As String) As String
GetFileExtension = Right(FullPath, Len(FullPath) - InStrRev(FullPath, ".", -1) + 1)
End Function
Public Function GetFullPath(ByVal FullPath As String) As String
GetFullPath = Left(FullPath, InStrRev(FullPath, "\", -1))
End Function