Soru Veri Al yaparken kod da düzeltme

[excellkurdu]

Arkadaşlar Merhaba,
Veri al yaparken Mevcut Makro Boş hücreleri atlayarak Bir sonraki dolu hücreyi alıyor.
Oysa Dataya daha öce yüklediğim 150 adet tuzak var. Bunların bazılarını satırlarından sildim.
Data veri al yapınca O sildiğim satırlara bir sonraki dolu satır geliyor. Oysa boş ise alırken de boş olmalı.
Mevcut makroyu sizlerden aldım ve benim için şuana kadar en hızlı çalışan AL makrosu. Bunu nasıl düzeltebiliriz.
Şimdiden teşekkür ederim.
https://s7.dosya.tc/server19/3nxjjf/deneme.xlsm.html

Sub ALL_BOCEK_TEK1()
'Sayfa tarihine göre veri alıyor
    Call hesaplama
Application.ScreenUpdating = False
On Error Resume Next

Sheets("BÖCEK").Range("C5:R104").ClearContents
Set s3 = ThisWorkbook.Worksheets("Veri")
Set s1 = ThisWorkbook.Worksheets(s3.Cells(18, "AH").Value)
Set s2 = ThisWorkbook.Worksheets("BÖCEK")
's2.Cells(1, 15) = s3.Cells(14, 3) 'Tarih

For i = 2501 To s1.Range("c3000").End(xlUp).Row
If s1.Cells(i, "c") = s2.Cells(1, "O") Then
For k = 6 To 4790 Step 16
sonsatir = s2.Range("c3000").End(xlUp).Row + 1
s2.Cells(sonsatir, 3) = s1.Cells(i, k + 0)
s2.Cells(sonsatir, 4) = s1.Cells(i, k + 1)
s2.Cells(sonsatir, 5) = s1.Cells(i, k + 2)
s2.Cells(sonsatir, 6) = s1.Cells(i, k + 3)
s2.Cells(sonsatir, 7) = s1.Cells(i, k + 4)
s2.Cells(sonsatir, 8) = s1.Cells(i, k + 5)
s2.Cells(sonsatir, 9) = s1.Cells(i, k + 6)
s2.Cells(sonsatir, 10) = s1.Cells(i, k + 7)
s2.Cells(sonsatir, 11) = s1.Cells(i, k + 8)
s2.Cells(sonsatir, 12) = s1.Cells(i, k + 9)
s2.Cells(sonsatir, 13) = s1.Cells(i, k + 10)
s2.Cells(sonsatir, 14) = s1.Cells(i, k + 11)
s2.Cells(sonsatir, 15) = s1.Cells(i, k + 12)
s2.Cells(sonsatir, 16) = s1.Cells(i, k + 13)
s2.Cells(sonsatir, 17) = s1.Cells(i, k + 14)
s2.Cells(sonsatir, 18) = s1.Cells(i, k + 15)
Next k
End If
Next i
Application.ScreenUpdating = True
Call hesapla
End Sub