Döngüyü neden sonlandıramıyorum

Sub bsn()
'Birim Sıra No Birim personel sayısına göre sıralar. List B sütunu
Dim i As Long, sh As Worksheet
Set sh = Sheets("Grup")
Application.Calculation = xlCalculationManual
sh.Range("A3:A" & Rows.Count).ClearContents
sonsat = sh.Cells(Rows.Count, 1).End(1).Row
For i = 3 To sonsat
sh.Cells(i, "A:A").Value = WorksheetFunction.CountIf(sh.Range("F3:F" & i), sh.Cells(i, "F").Value)
Next i
Application.Calculation = xlCalculationAutomatic
End Sub

değerli hocalarım bu döngü neden sonlanmıyor. Nasıl sonlandırabilirim bu döngüyü. F sütununa göre sıra numarası veriyorum.