Trying to copy one row tens of thousands of times - my code is rubbish!

[TheWennerWoman]

Sub test()
With Worksheets("element_bf")
    Dim lr As Long: lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
Worksheets("element_rec").Range("A2:EO2").Cells.Copy
For a = lr To 3 Step -1
With Worksheets("element_rec")
        .Cells(lr, 1).PasteSpecial xlAll
        lr = lr - 1
End With
Next a
End Sub

Can anyone improve on this, this is taking forever and I know it's due to my poor coding!

Many thanks!

EDIT: these are formulae

 

[Fluff]

How about

With Worksheets("element_bf")
    Dim lr As Long: lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
Worksheets("element_rec").Range("A2:EO2").Resize(lr - 1).FillDown
End Sub

 

[TheWennerWoman]

Excellent Mr Fluff, thank you very much

 

[Fluff]

You're welcome & thanks for the feedback.