Sub Speichern_EPG()
Dim sh As Worksheet
Dim rng As Range
ActiveWorkbook.Sheets.Copy
For Each sh In ActiveWorkbook.Worksheets
For Each rng In sh.UsedRange.Cells
rng.Formula = rng.Value
Next
Next
Dim ord As String
Dim Dateiname As String
Dim Antwort As Integer
Dim Wert As String
Dim rngZelle As Range
Dim lngAnz As Long
Wert = [A2].Value
ord = "P:\gba\abteilungen\AEC\EPLAN\Data\Projekte\KEBA AG\" & Wert & ".edb" & "\DOC" & "\Angebot"
If Dir(ord, vbDirectory) <> "" Then
MsgBox "Ein Ordner mit dem Namen Angebot ist im Verzeichnis " & ord & " schon vorhanden!"
MsgBox "Es wird kein Ordner angelegt das Dokument wird jedoch in den vorhandenen Ordner gespeichert!"
Else
Antwort = MsgBox("Der Ordner " & ord & " ist nicht vorhanden!" _
& vbNewLine _
& "Soll der Ordner angelegt werden?", vbYesNo)
If Antwort = vbYes Then
MkDir ord
MsgBox "Der Ordner " & ord & " wurde angelegt und die Datei darin gespeichert!"
Else
MsgBox "Es wurden keine Änderungen vorgenommen!"
End If
End If
ActiveWorkbook.SaveAs Filename:="P:\gba\abteilungen\AEC\EPLAN\Data\Projekte\KEBA AG\" & Wert & ".edb" & "\DOC" & "\Angebot\Preisliste_SSL_Lieferanten_V0_EPG.xlsx"
ActiveWorkbook.Close True
End Sub