ريما نال الاعجاب
الكود
Option Explicit
Sub Salim_Index()
Application.ScreenUpdating = False
Dim S_sh As Worksheet: Set S_sh = Sheets("بيانات التلاميذ")
Dim Index_sh As Worksheet: Set Index_sh = Sheets("فَهرَست")
Dim Targ_sh As Worksheet: Set Targ_sh = Sheets("Sapace")
Dim my_st1$, my_st2$
Dim lr%: lr = S_sh.Cells(Rows.Count, 1).End(3).Row
Dim New_Lr%
Dim Flt_Rg As Range: Set Flt_Rg = S_sh.Range("a15:k" & lr)
Dim k%, m%: m = 6
Index_sh.Range("a6:F150").ClearContents
Targ_sh.Cells.Clear
my_st1 = "=" & UCase(Index_sh.[g5] & "*") & ""
Flt_Rg.AutoFilter Field:=5, Criteria1:=my_st1
Flt_Rg.Columns(3).SpecialCells(xlCellTypeVisible).Copy
Targ_sh.Range("a5").PasteSpecial Paste:=xlPasteValues
Flt_Rg.Columns(5).SpecialCells(xlCellTypeVisible).Copy
Targ_sh.Range("b5").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Flt_Rg.AutoFilter
New_Lr% = Targ_sh.Cells(Rows.Count, 1).End(3).Row
For k = 6 To New_Lr% Step 2
Index_sh.Cells(m, 2) = Targ_sh.Cells(k, 1): Index_sh.Cells(m, 1) = k - 5
Index_sh.Cells(m, 3) = Targ_sh.Cells(k, 2)
Index_sh.Cells(m, 5) = Targ_sh.Cells(k + 1, 1): Index_sh.Cells(m, 4) = k - 4
Index_sh.Cells(m, 6) = Targ_sh.Cells(k + 1, 2)
m = m + 1
Next
Application.ScreenUpdating = True
End Sub
Salim_Index.xlsm