die Gültigkeitsprüfung bezieht sich auf eine Liste in einem anderen Arbeitsblatt. Die Liste werde ich aber - wenn das Makro läuft - löschen und die Daten direkt in die Gültigkeitsprüfung unter Quelle eingeben (x;y;z).
Habe das Makro mal mit einer einfachen Datei ausprobiert - da kommt keine Fehlermeldung bzw. die gespeicherte Datei ist lesbar & der ausgewählte Wert aus der Auswahlliste wird angezeigt. Die Gültigkeitsprüfung ist dann natürlich nicht mehr vorhanden.
Sub Dateiname()
Dim strName As String
Dim strDatei As String
Application.DisplayAlerts = False
strName = Year(Date)
If Month(Date) < 10 Then
strName = strName & "_0" & Month(Date)
Else
strName = strName & "_" & Month(Date)
End If
If Day(Date) < 10 Then
strName = strName & "_0" & Day(Date)
Else
strName = strName & "_" & Day(Date)
End If
strName = strName & "_" & Left(Range("B8"), 10) & "_" & Left(Range("B10"), 12) & "_" & Left(Range("B18"), 20) & ".xlsx"
'Benachrichtungen ausschalten
Application.DisplayAlerts = False
Sheets("anfrage -auftrag").Select
Sheets("anfrage -auftrag").Copy
ActiveSheet.Shapes("Datei_speichern_versenden").Delete
'Es werden keine Formeln, nur Werte übernommen die Formeln für die Durchschnittsberechnung wieder hineingeschrieben
ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
Range("AO71").FormulaLocal = "=WENNFEHLER(MITTELWERT(AK71:AM76);"""")"
Range("AO72").FormulaLocal = "=WENNFEHLER(AO71/T23;"""")"
Datei = Application.GetSaveAsFilename(InitialFileName:=strName, fileFilter:="Excel-Arbeitsmappe, *.xlsx")
'falls Abbruch gewählt wird, dann Makro beenden
If Datei = False Then
ActiveWorkbook.Close
End
End If
'Prüfen, ob Blattschutz vorhanden ist und falls ja, dann Blattschutz aufheben:
With ActiveSheet
If .ProtectContents = True Then .Unprotect "xxx"
'Blattschutz wieder aktivieren
.Protect "xxx"
End With
'als xlsx Datei speichern
ActiveWorkbook.SaveAs Filename:=Datei, FileFormat:=xlOpenXMLWorkbook
'Benachrichtungen wieder einschalten
Application.DisplayAlerts = True
End Sub