VBA Excel paste special speed reduces over time while looping

Hi All,

Thanks for reading this post.

I am trying to copy and paste cell format only. I realise that the looping speed reduces over time, could someone please explain to me why this is happening and how to solve this problem. Thanks a lot.

Following is my code, and the macro file is attached.

Sub xz()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayStatusBar = False
End With

Dim copyrange As Range
Dim b As Long: b = 2304
Dim c As Variant

Set copyrange = Sheets("H").Range("A1:AK2304")
copyrange.Copy
Sheets.Add after:=Sheets(Sheets.Count)

For i = 0 To 10
c = Timer
Cells((b * i) + 1, 1).PasteSpecial Paste:=xlPasteFormats
Debug.Print Timer - c
Next i

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayStatusBar = True
End With
End Sub

speed for each loop
0.1425781
0.1855469
0.2285156
0.2871094
0.3417969
0.3945313
0.4492188
0.4941406
0.5429688
0.5898438
0.6523438

Attachment 27996Attachment 27996Attachment 27996