Excel VBA, einen Wert setzten?

Sub DienstplanDrucken()
Application.DisplayAlerts = False
'Als erstes wird die Datei im Ordner gespeichert wo sie hin gehört
MsgBox "Bitte wählen Sie den Pfad aus wo der Dienstplan gespeichert werden soll, Sie können  _
auch einen neuen ordner anlegen! Die PDF werden dann in diesem Ordner abgelegt!!", vbInformation, "(c) 2018 GSF-ArnolPe"
Dim Dateiname As String
'Dateiname basteln - Jahr Monat Tag
Dateiname = Format(Date, "YYYY_MM_DD") & "_" & Range("A7").Value & ".xlsx"
'Dialog "Speichern unter" aufrufen und Dateinamen vorgeben
Application.Dialogs(xlDialogSaveAs).Show Dateiname
'Auschalten der Bildschirmaktualisierung (verhindert das flackern :-))
Application.ScreenUpdating = False
'Personalnummer auf 7 Stellen anpassen, füge neben die Splate J eine neue Spalte ein
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J28").Select
'Gebe der Spalte eine Überschrift
ActiveCell.FormulaR1C1 = "LANR"
Range("J29").Select
'Formatiere die Zelle als Text mit 7 mal 0 von links
ActiveCell.FormulaR1C1 = "=TEXT(RC[1],""0000000"")"
Dim lngLast As Long
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
'Kopiere die Formel bis zur letzen befüllten Zelle
Range("J29").AutoFill Destination:=Range("J29:J" & lngLast)
'Kopieren und einfügen, damit nur die Werte aber nicht die Formlen stehen bleiben
Columns("J:J").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
ActiveSheet.ResetAllPageBreaks 'lösche alle evtl. Seitenumbrüche
'Es werden alle Zeilen nach Name und Datum sortiert
Range("A28:M28").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
"F28:F65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
"I28:I65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range( _
"H28:H65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A28:M65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$65000"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.PrintErrors = xlPrintErrorsDisplayed
End With
Application.PrintCommunication = True
Range("A28:M28").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Festlegen der Parameter für Gesamtdruck
Dim lngZ As Long
Dim lngZBeginn As Long
'Seitenumbruch je Gruppe (Name) in Spalte setzen
lngZBeginn = 28
For lngZ = 28 To Range("F" & Rows.Count).End(xlUp).Row 'ab Zeile 28
If Range("F" & lngZ)  Range("F" & lngZ + 1) Then
'Seitenumbrüche einfügen
ActiveSheet.HPageBreaks.Add Before:=Range("A" & lngZ + 1)
End If
Next
'Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = "A" & lngZBeginn & ":G" & lngZ - 1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Range("F" & _
_
lngZ) & "00_" & Range("A7") & ("_") & Format(Date, "YYYY_MM_DD_") & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'ActiveSheet.PrintOut sofort auch an Standartdrucker senden
'Festlegen Parameter für Einzeldruck
'Dienstplan einzeln als PDF ausgeben
For lngZ = 28 To Range("F" & Rows.Count).End(xlUp).Row 'ab Zeile 28
If Range("F" & lngZ)  Range("F" & lngZ + 1) Then
ActiveSheet.PageSetup.PrintArea = "A" & lngZBeginn & ":G" & lngZ
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" &  _
Range("F" & lngZ) & "_" & Format(Date, "YYYY_MM_DD_") & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
lngZBeginn = lngZ + 1
'Hier kann man die PDF auch gleich an den Drucker senden....
'ActiveSheet.PrintOut sofort auch an Standartdrucker senden
End If
Next
'Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = "A1:G" & lngZ - 1
'Bildchirm wieder einschalten
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveSheet.ResetAllPageBreaks
MsgBox "Das war es auch schon, Die PDF-Dateien sind in Ihrem vorgelegtem Ordner abgespeichert... _
...", vbInformation, "(c) 2018 GSF-ArnolPe"
End Sub