Try this simple code:
Sub test()
Dim i As Long
For i = 2 To 7
  Cells(17, 2).Resize(1, 10).Value = Application.WorksheetFunction.Transpose(Cells(4, i).Resize(10, 1))
  Application.Calculate
  Cells(4, i + 8).Resize(10, 1).Value = Application.WorksheetFunction.Transpose(Range("B18:K18"))
Next i
End Sub