copy every cells in a column to particular cell in new sheet every time with a loop - excel

Question

I seek your help to copy the cell values in (column D) of the first worksheet to a specified cell location in 16 existing worksheets
i want value in
D2 in in sheet1 to sheet2 (G5)
D3 in in sheet1 to sheet3 (G5)
D4 in in sheet1 to sheet4 (G5)
and so on until the D16 is copied to G5 of sheet16
i am a newbie, i looked into several answers and tried to work out on my own but.... nothing happened
Sub latitude()
Dim WS_Count As Integer
Dim I As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Do Until IsEmpty(ActiveCell)
Sheets("Calculations").Select
Range("d2").Copy
ActiveCell.Offset(1, 0).Select
'at this point i want it to copy "D3" on next loop
ActiveSheet.Range("G5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Loop
ActiveSheet.Next.Select
' and because the "Sheets("Calculations").Select" above takes it to the first sheet the whole script is a waste till now
Next I
End Sub

Answer 1

Alistairs attempt is good, i would however not use shtname = "Sheet" & i, instead try the following solution and think about bulletprooving it a bit (existance of worksheets) ;)
Sub Copy_to_G5()
Dim i As Integer
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
i = 2
Do Until i = 17
With ThisWorkbook
.Worksheets(1).Cells(i, 4).Copy
.Worksheets(i).Range("G5").PasteSpecial
End With
i = i + 1
Loop
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Answer 2

Give this a try.
Option Explicit
Sub Copy_to_G5()
Dim sht1 As Worksheet, ws As Worksheet
Dim i As Integer
Dim shtname As String
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set sht1 = Sheets("Sheet1")
i = 2
Do Until i = 17
shtname = "Sheet" & i
sht1.Cells(i, 4).Copy
Sheets(shtname).Range("G5").PasteSpecial
i = i + 1
Loop
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub