Sub CallSude()
Dim ws As Worksheet, Sh As Worksheet
Dim i As Long, p As Long, j As Long
Dim LR As Long, Fasl As String
Application.ScreenUpdating = False

Set ws = Sheets("laskat")
For x = 3 To 58 Step 5
ws.Cells(x, 3).ClearContents
ws.Cells(x + 1, 3).ClearContents
ws.Cells(x + 1, 6).ClearContents
ws.Cells(x + 2, 4).ClearContents

ws.Cells(x, 12).ClearContents
ws.Cells(x + 1, 12).ClearContents
ws.Cells(x + 1, 15).ClearContents
ws.Cells(x + 2, 13).ClearContents
Next

Fasl = ws.Range("S8").Text
Set Sh = Sheets("data")
LR = Sh.Range("C" & Rows.Count).End(3).Row

For i = 3 To LR
If Sh.Cells(i, 14) = Fasl Then
p = p + 1
j = 2
Do While j <= 57
If ws.Cells(j, 8) = p Then
ws.Cells(j + 1, 3) = Sh.Cells(i, 3)
ws.Cells(j + 2, 3) = Sh.Cells(i, 15)
ws.Cells(j + 2, 6) = Sh.Cells(i, 14)
ws.Cells(j + 3, 4) = Sh.Cells(i, 5)

ElseIf ws.Cells(j, 17) = p Then
ws.Cells(j + 1, 12) = Sh.Cells(i, 3)
ws.Cells(j + 2, 12) = Sh.Cells(i, 15)
ws.Cells(j + 2, 15) = Sh.Cells(i, 14)
ws.Cells(j + 3, 13) = Sh.Cells(i, 5)

End If
j = j + 5
Loop
End If
Next

Application.ScreenUpdating = True
End Sub