Copy and paste to different worksheets

Question

This code:

1. Copies a value from "Sheet1"
2. Pastes special (as a number) in another sheet "Sheet2"
3. Jumps to the next line

I already:

1. Disabled screen refresh

2. 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?

Answer 1

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