Copy and paste to different worksheets

This code:

• Copies a value from "Sheet1"

• Pastes special (as a number) in another sheet "Sheet2"

• Jumps to the next line

I already:

• Disabled screen refresh

-
Wrapped the code with Application.EnableEvents = False and Application.Calculation = xlCalculationManual

1 made the calculation a little faster, but 2 didn't seem to make any effect.

Dim iterations, counter As Integer
iterations= 10000
counter = 1

Do While counter <= iterations

' copy value from Sheet1
Sheets("Sheet1").Range("B4").Copy

' paste value in sheet2
Sheets("Sheet2").Select

Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Range("A1").Select

counter = counter + 1

Loop

I usually run 50,000+ iterations (counter = 50000).

How can I improve this code speed?

if your aim is to:

-
copy the value in cell "B4" of worksheet "Sheet1"

-
and paste it in worksheets "Sheet2" from cell "A1" downwards in iterations cells

then simply use:

Dim iterations: iterations = 1000    
Worksheets("Sheet2").range("A1").Resize(iterations).value = Worksheets("Sheet01").range("B4").value

if your aim is to:

-
copy the value from cell "B4" of worksheet "Sheet1" and down to iterations cells

-
and paste them in worksheets "Sheet2" from cell "A1" downwards in iterations cells

then simply use:

Dim iterations: iterations = 1000    
Worksheets("Sheet2").range("A1").Resize(iterations).value = Worksheets("Sheet01").range("B4").Resize(iterations).value

StackExchange Code Review Q#136499, answer score: 3