Einfügen von Zellbezügen VBA

Private Sub Auftr_kop_M1_Click()
ActiveSheet.Unprotect "suse"
Dim wZ As Worksheet
Dim LR
Dim Maschine As Range
Dim Merker As Range
ThisWorkbook.Activate
With Worksheets("Aufträge").ListObjects("Aufträge1")
For Each LR In .ListRows
Set LR = LR.Range.EntireRow
If Not LR.Hidden Then
Set Maschine = Intersect(LR, .ListColumns("Spalte19").Range)
Set Merker = Intersect(LR, .ListColumns("Spalte22").Range)
Set Artikel = Intersect(LR, .ListColumns("Spalte3").Range)
Set Beschreibung = Intersect(LR, .ListColumns("Spalte4").Range)
Set Menge = Intersect(LR, .ListColumns("Spalte6").Range)
Set Fertigungszeit = Intersect(LR, .ListColumns("Spalte10").Range)
Set Entgratzeit = Intersect(LR, .ListColumns("Spalte13").Range)
Set Meilenstein = Intersect(LR, .ListColumns("Spalte14").Range)
Set Beschichtung = Intersect(LR, .ListColumns("Spalte18").Range)
If Merker.Value = "" And Maschine.Value  "" And Artikel.Value  "" And Beschreibung.Value  "" And Menge.Value  "" And Meilenstein.Value  "" And Beschichtung.Value  "" And Fertigungszeit.Value  "" And Entgratzeit.Value  "" Then
Set wZ = SelectOrCreate(Maschine.Value)
Set Z = wZ.Range("D99999").End(xlUp)
If Z = "" Then Set Z = Z.End(xlUp).Offset(1) Else Set Z = Z.Offset(1)
Set Z = Z.EntireRow
If IsEmpty(LR.Range("B1")) = True Then
Z.Range("D1:H1") = LR.Range("C1:G1").Value
Z.Range("K1") = LR.Range("J1").Value
Z.Range("O1") = LR.Range("N1").Value
Z.Range("Q1:S1") = LR.Range("P1:R1").Value      //hier benötige ich eine Änderung
Merker.Value = "ü"
Merker.Font.Name = "Wingdings"
Else
Z.Range("C1") = LR.Range("B1").Hyperlinks(1).Address
Z.Range("D1:H1") = LR.Range("C1:G1").Value
Z.Range("K1") = LR.Range("J1").Value
Z.Range("O1") = LR.Range("N1").Value
Z.Range("Q1:S1") = LR.Range("P1:R1").Value
Merker.Value = "ü"
Merker.Font.Name = "Wingdings"
End If
End If
End If
Next
End With
Private Function SelectOrCreate(ByVal Blattname As String) As Worksheet
Dim W As Worksheet
On Error Resume Next
Set W = Worksheets(Blattname)
If W Is Nothing Then
Set W = Worksheets("Vorlage").Copy(After:=Worksheets(Worksheets.Count))
W.Name = Blattname
End If
Set SelectOrCreate = W
End Function

Z.Range("Q1:S1") = LR.Range("P1:R1").Value

 Z.Range("Q1") = LR.Range("P1"). Value
Z.Range("R1") = LR.Range("Q1"). Value      //hier benötige ich beim einfügen nicht den Wert in der Zielzelle, sondern einen Zellbezug
Z.Range("S1") = LR.Range("R1"). Value

=Aufträge!Q132