I think the array approach (while potentially a tad faster) is way more complicated than just Match-ing and copying data
pr28 and pr29 are not on 'destination'
Option Explicit
Dim rDest As Range
Sub MoveData()
Dim rTest As Range, rPR As Range, rTB As Range, rQR As Range, rTR As Range, rZT As Range
Set rDest = Worksheets("destination").Range("B1")
Set rTest = Worksheets("origin").Range("A4")
Set rPR = Worksheets("origin").Range("D4")
Set rTB = Worksheets("origin").Range("F4")
Set rQR = Worksheets("origin").Range("H4")
Set rTR = Worksheets("origin").Range("J4")
Set rZT = Worksheets("origin").Range("L4")
Set rDest = Range(rDest, rDest.End(xlToRight))
Call pvtCopy(Range(rTest, rTest.End(xlDown)))
Call pvtCopy(Range(rPR, rPR.End(xlDown)))
Call pvtCopy(Range(rTB, rTB.End(xlDown)))
Call pvtCopy(Range(rQR, rQR.End(xlDown)))
Call pvtCopy(Range(rTR, rTR.End(xlDown)))
Call pvtCopy(Range(rZT, rZT.End(xlDown)))
End Sub
Private Sub pvtCopy(r As Range)
Dim rCell As Range
Dim i As Long
For Each rCell In r.Cells
i = 0
On Error Resume Next
i = Application.WorksheetFunction.Match(rCell.Value, rDest, 0)
On Error GoTo 0
If i <> 0 Then rDest.Cells(1, i).Offset(1, 0).Value = rCell.Offset(0, 1).Value
Next
End Sub