Textbox text kopieren

Sub Probenahme()
Dim WB As Workbook, WS As Worksheet, lZ As Long, lR As Long
Application.ScreenUpdating = True
lR = ActiveCell.Row
If Cells(lR, 2) = "" Then
Workbooks.Open ("Z:\Firma\Werk 6-056\Probenahmeverzeichnis\2018\Probenahme.xlsm")
Else
Set WS = ActiveSheet
Set WB = Workbooks.Open("Z:\Firma\Werk 6-056\Probenahmeverzeichnis\2018\Probenahme.xlsm")
With WB.Worksheets("Probenahme")
lZ = .Cells(Rows.Count, 2).End(xlUp).Row + 1
.Cells(lZ, 2) = Format(DateValue(WS.Cells(lR, 2)), "dd.mm.yy")
.Cells(lZ, 4) = WS.Cells(lR, 9)
.Cells(lZ, 5) = WS.Cells(lR, 4)
.Cells(lZ, 7) = WS.Cells(lR, 6)
.Cells(lZ, 8) = WS.Cells(lR, 8)
End With
End If
End Sub

.Cells(lZ, 2) = Format(DateValue(WS.Cells(lR, 2)), "dd.mm.yy")

.Cells(lZ, 2) = Format(DateValue(WS.textbox3.text), "dd.mm.yy")