السادة اعضاء المنتدي الذي تعلمنا منه كثيرا
بعد سلام الله عليكم ورحمة الله وبركاته..نرجو من حضراتكم تصحيح الخطأ في هذا الكود المرفق ... ولكم جزيل الشكر ووافر الاحترام
انتبه من فضلك ... مشاركة مكررة .. تــــم بالفعل حذف المشاركة الأخرى
هذا هو الكود وهذه رسالة الخطأ الذى تظهر , يجب عليك التوضيح هكذا
Sub Test()
Dim a, ws As Worksheet, sh As Worksheet, s As String, i As Long, ii As Long, k As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets("مجمع الشيتات")
Set sh = ThisWorkbook.Worksheets("قوائم الفصول")
With ws
a = .Range("C10:P" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
a = Application.Index(d, Evaluate("ROW(4:" & UBound(d, 4) & ")"), [{3,4,5,7,9,11,12,15,16}])
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
s = sh.Range("F4").Value
sh.Range("C10").CurrentRegion.Offset(1).ClearContents
If IsEmpty(s) Then Exit Sub
sh.Columns(3).NumberFormat = "@"
sh.Columns(8).NumberFormat = "@"
For i = LBound(a, 1) To UBound(a, 1)
If a(i, 7) = s Then
k = k + 1
b(k, 1) = k
For ii = 3 To UBound(a, 2)
b(k, ii) = a(i, ii)
Next ii
End If
Next i
If k > 0 Then sh.Range("C10").Resize(k, UBound(d, 4)).Value = b
End With
End Sub
مجمع الشيتات.rar