Sub
Test()
nr = 13
Dim
strPath
As
String
, strSaveName
As
String
, strFilename
With
Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect =
False
.InitialFileName = "C:\Temp\"
.Title =
"Ordner auswählen"
If
.Show
Then
strPath = .SelectedItems(1)
End
With
If
Len(strPath) = 0
Then
Exit
Sub
strFilename =
"Nr. "
& nr &
"_"
& Artikel &
"_"
&
Date
&
".xls"
strSaveName = ThisWorkbook.FullName
strSaveName = Replace(strSaveName, ThisWorkbook.Path, strPath)
strSaveName = Replace(strSaveName, ThisWorkbook.Name, strFilename)
ActiveWorkbook.SaveAs strSaveName, -4143
End
Sub