Dim t(), t1(), x As Long, i As Long, k As Long, y As Byte
Sub es()
t = Range("a1:d10")
x = 1
For i = 1 To UBound(t)
For y = 1 To 3: t(i, 4) = t(i, 4) + t(i, y): Next y
t(i, 4) = t(i, 4) / 3
ReDim Preserve t1(4 To 4, 1 To x)
For k = 4 To 4
t1(k, x) = t(i, k)
Next k: x = x + 1: Next i
[d1].Resize(x - 1, 1) = Application.Transpose(t1)
End Sub