VBA Speichern unter

Sub Exportieren Aktualiesieren()
' Kopieren aktueller stand in alten Stand
Range("A6:L98").Copy
Sheets("Alter Stand").Select
Range("a4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabetabelle").Select
Range("F1").Copy
Sheets("Alter Stand").Select
Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' Kopieren der Neuerungen und Zusamenfassen sowie speichern unter
Range("T6:AU99").Copy
Sheets("Endstellenbelegung").Visible = True
Sheets("Endstellenbelegung").Select
Range("A5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
Worksheets("Endstellenbelegung").Copy
VorlPfad = "C:"
gDir = VorlPfad
ChDrive Left(gDir, 2)
ChDir gDir
'Dialog öffnen
Application.Dialogs(xlDialogSaveAs).Show
Dim rng As Range
For Each rng In Range("A4:R99")
If rng.Value = 0 Then rng.ClearContents
Next
Dim i As Long, laR As Long
Application.ScreenUpdating = False
On Error Resume Next
laR = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
On Error GoTo 0
If laR = 0 Then Exit Sub
For i = laR To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Cells(i, 1).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
Range("A4").Select
Windows("test3.xls").Activate
Sheets("Eingabetabelle").Select
Range("A6").Select
Sheets("Endstellenbelegung").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Eingabetabelle").Select
Dim Zelle As Range
Dim lngA As Long
Dim lngB As Long
For Each Zelle In Range("M6:R99")
lngA = Range(Zelle.Address).Row
lngB = Range(Zelle.Address).Column
If Zelle  "" Then Cells(lngA, lngB - 6) = Zelle
Next
Range("M6:R99").ClearContents
Range("A6:L98").Copy
Sheets("Alter Stand").Select
Range("o4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A4").Select
Sheets("Eingabetabelle").Select
Range("F1").Copy
Sheets("Alter Stand").Select
Range("B1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Eingabetabelle").Select
Range("A6").Select
End Sub