توزيع اللجان دفعة واحدة بالأكواد

Sub Print_All()

    Dim i As Long

    

    With Sheets("Legan")

        .Range("E1").Value = 1

        Call Legan_Test

        

        Do Until .Range("H11").Value = ""

            i = i + 2

            .Range("E1").Value = i - 1

            Call Legan_Test

            If .Range("H11").Value = "" Then Exit Do

            .PrintPreview

        Loop

    End With

End Sub

   If .Range("H11").Value = "" Then Exit Do

Sub AddLists()

Const S = 44

Dim Mn As Worksheet

Dim Dist As Worksheet

Dim List As Worksheet

Dim Arr As Variant

Dim Temp As Variant

Dim x As Integer, y As Integer, z As Integer

Dim LR As Long, n As Long, i As Long, j As Long, p As Long



Application.ScreenUpdating = False

Set Mn = Sheets("Main")

Set Dist = Sheets("ورقة2")

Set List = Sheets("Legan")

List.Range("D8") = 1

List.Range("I8") = 2

On Error Resume Next

List.Range("B47:J" & List.Range("H" & Rows.Count).End(xlUp).Row + 46).Clear

x = WorksheetFunction.Max(Dist.Range("E8:E" & Dist.Range("H" & Rows.Count).End(xlUp).Row))

If x Mod 2 = 1 Then

y = Int(x / 2)

Else

y = Int(x / 2) - 1

End If

z = y * S + 46

If y > 1 Then

List.Range("B3:J46").Copy

For n = 47 To z Step 44

List.Range("B" & n).PasteSpecial xlPasteAll

List.Range("D" & n + 5) = List.Range("D" & n - 39) + 2

List.Range("I" & n + 5) = List.Range("I" & n - 39) + 2



Next

End If

List.Range("B8").Select

Application.CutCopyMode = False



For n = 11 To z Step 44

List.Range("B" & n & ":J" & n + 29).ClearContents

List.Range("D" & n + 31 & ":E" & n + 33).ClearContents

List.Range("I" & n + 31 & ":J" & n + 33).ClearContents

Next



Application.ScreenUpdating = True



End Sub

Sub FillLists()

Dim Mn As Worksheet

Dim Dist As Worksheet

Dim List As Worksheet

Dim LR As Long, n As Long, i As Long, p As Long, q As Long

Dim x, y, z

Dim xx, yy, zz

Set Mn = Sheets("Main")

Set Dist = Sheets("ورقة2")

Set List = Sheets("Legan")

LR = Mn.Range("D" & Rows.Count).End(xlUp).Row

For n = 8 To List.Range("D" & Rows.Count).End(xlUp).Row Step 44

For i = 8 To LR

If Mn.Cells(i, "S") = List.Cells(n, "D") Then

p = p + 1

List.Cells(p + n + 2, "C") = Mn.Cells(i, "D")

List.Cells(p + n + 2, "D") = Mn.Cells(i, "B")

List.Cells(p + n + 2, "E") = Mn.Cells(i, "G")

List.Cells(p + n + 2, "B") = p

x = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسلم" & "*")

y = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسيحى" & "*")

List.Range("D" & n + 35) = x

List.Range("D" & n + 36) = y

List.Range("D" & n + 34) = x + y



End If

Next

p = 0

For i = 8 To LR

If Mn.Cells(i, "S") = List.Cells(n, "I") Then

q = q + 1

List.Cells(q + n + 2, "H") = Mn.Cells(i, "D")

List.Cells(q + n + 2, "I") = Mn.Cells(i, "B")

List.Cells(q + n + 2, "J") = Mn.Cells(i, "G")

List.Cells(q + n + 2, "G") = q

xx = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسلم" & "*")

yy = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسيحى" & "*")

List.Range("I" & n + 35) = xx

List.Range("I" & n + 36) = yy

List.Range("I" & n + 34) = xx + yy



End If

Next

q = 0

Next

End Sub