Office: (Office 2010) VBA Makro speicherung

Hallo Forengemeinde

Habe stehe nun wieder einen Problem gegeüber,vielleicht kann mir jemand von euch helfen.

Ausgangslage ist, ich habe ein Makro geschrieben das in meinen Programm eine fertige Datei erstellt und dies in einen Ordner ablegt.

Im Excel habe ich in einer Zelle den Ort hinein geschrieben wo er es speichern soll, dieser Zelle habe ich einen Namen gegeben SavePath. Nun möchte ich im Makro einen weiteren Path angeben ebenfalls eine Zelle mit namen und in dieser Zelle steht wieder wo er es speichern soll.

---------------------

Sub progspeichern()

Dim Lösch As Integer
Dim Progrange As Range
Dim frowprog As Integer
Dim frowKissA As Integer
Dim namKissA As String
Dim dname As String
Dim fname As String
Dim fullfname As String
Dim Ptag As Date
'Dim datstr As String
'Dim Outl As Object
'Dim oulmail As MailItem
'Dim oulitems As Items
'Dim olNS As NameSpace
'Dim olMAPIFolder As MAPIFolder
Dim version As Integer
Ptag = Range("Progtag")
'Punkte aus Datum entfernen
dname = Range("KADatum")
Set Progrange = ActiveSheet.Range("Pbereich")
frowprog = Progrange.Row
frowKissA = Range("frowKissA")
namKissA = Range("namKissA")
fullfname = Range("KissA")
Workbooks.Open Filename:=fullfname
Workbooks("Stromprognose erstellen.xlsm").Activate
For Each I In Progrange
Workbooks(namKissA).Sheets(2).Cells(4 * (I.Row - frowprog) + frowKissA, 3).Formula = I
Workbooks(namKissA).Sheets(2).Cells(4 * (I.Row - frowprog) + frowKissA + 1, 3).Formula = I
Workbooks(namKissA).Sheets(2).Cells(4 * (I.Row - frowprog) + frowKissA + 2, 3).Formula = I
Workbooks(namKissA).Sheets(2).Cells(4 * (I.Row - frowprog) + frowKissA + 3, 3).Formula = I
Next
Workbooks(namKissA).Sheets(2).[A1].Formula = "Intern"
Workbooks(namKissA).Sheets(2).[C5].Formula = "14Xtestdatei"
'Aktuelles Datum in Vorlage
Workbooks(namKissA).Sheets(1).[C1].Formula = Ptag
Workbooks(namKissA).Sheets(2).[C1].Formula = Ptag
Workbooks(namKissA).Sheets(2).Name = "Intern"
fname = dname & Range("Fnampro") '"_PRODUKTION_14Xtestdatei_10YAT-APG------L_01.xls"
fullfname = Range("SavePath") & fname
'prognose schon früher abgespeichert?
If Dir(fullfname) <> "" Then
Lösch = MsgBox("Eine Prognose für " & Ptag & " existiert bereits. Aktuelle Version senden oder abbrechen!", 65 _
, "Alte Prognose ersetzen!")
If Lösch = 2 Then
MsgBox "Datei wurde nicht gesendet!", , "Abbruch"
Workbooks(namKissA).Saved = True
Workbooks(namKissA).Close
End
End If
'******************************************************************************
'Versionsnummer auslesen
Workbooks.Open Filename:=fullfname
version = Workbooks(fname).Sheets(2).[C8]
Workbooks(fname).Saved = True
Workbooks(fname).Close
version = version + 1
Workbooks(namKissA).Sheets(2).[C8] = version
'****************************************************************************
Kill fullfname
End If
Workbooks(namKissA).SaveAs (fullfname)
namKissA = dname & Range("Fnampro")
Workbooks(namKissA).Sheets(2).[A1].Formula = "Erzeugung"
Workbooks(namKissA).Sheets(2).[C5].Formula = ""
Workbooks(namKissA).Sheets(2).Name = "Erzeugung"
fname = dname & Range("FnamErz") '"_14Xtestdatei_10YAT-APG------L_ERZ_01.xls"
fullfname = Range("SavePath") & fname
'prognose schon früher abgespeichert?
If Dir(fullfname) <> "" Then
'Versionsnummer Erzeugung
Workbooks(namKissA).Sheets(2).[C8] = version
Kill fullfname
End If
Workbooks(namKissA).SaveAs (fullfname)
Workbooks(fname).Close
Workbooks("Stromprognose erstellen.xlsm").Sheets("Berechnung").Activate
If WorksheetFunction.Sum(Sheets("Siemens Regler").[F7:F26], Sheets("Siemens Regler").[H7:H26], _
Sheets("Siemens Regler").[J7:J26]) > 0 Then
'Workbooks("Stromprognose erstellen.xls").Sheets("Berechnung").PrintOut
'Workbooks("Stromprognose erstellen.xls").Sheets("Siemens Regler").PrintOut
End If
'Hinweis, wenn sofort gesendet wird
If Range("Sendetag") + Range("Sendezeit") < Now Then
Lösch = MsgBox("Soll die Prognose sofort gesendet werden? Die automatische Sendezeit wurde überschritten!!", 49 _
, "Datei vom " & Ptag & " senden?")
If Lösch = 2 Then
MsgBox "Datei wurde nicht gesendet!!", , "Abbruch"
End
End If
End If