المساعدة في كود

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