Daten in gesperrtes Tabellenblatt übertragen

Sub mehrfachauswahl()
Dim rngact As Range
Dim introw As Integer, intcol As Integer
Dim WS As Worksheet
If Range("A9") = "PA" Then
Set WS = Worksheets("Daten PA")
Else
Set WS = Worksheets("Daten PS (Primecast)")
End If
With WS
If IsEmpty(.Cells(1, 1)) Then
introw = 1
Else
introw = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
For Each rngact In Range("d9,e9,f9,q9,h9,q10,j9,q27,k9,k13,k14,q33,k15,k21,a9").Cells
intcol = intcol + 1
.Cells(introw, intcol) = rngact.Value
Next rngact
.Range(.Cells(introw, 16), .Cells(introw, 16)).Value = Date
End With
Application.CutCopyMode = False
End Sub