Macro to loop and copy

Try this:

Sub x()

Dim d As Double, r As Long

With Sheet2
    d = 336: r = 4
    Do While d <= 369.6
        .Range("F2").Value = d
        Sheet3.Cells(r, 1).Value = .Range("B11").Value
        d = d * 1.02: r = r + 1
    Loop
End With

End Sub