أخي الحبيب أبو نبأ
جرب الكود التالي لترحيل الأرقام الإحصائية
Sub Test()
Dim arr
Dim LR As Long
Set arr = Sheet1.Range("D4,J4,P4,D15,J15,P15")
LR = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
If LR = 1 Then
LR = LR
Else
LR = LR + 1
End If
arr.Copy Sheet3.Range("A" & LR)
End Sub