التعديل على الكود التالي

[ArefALhakimi]

ازالة مشكلة التكرار عند طلب البيانات بواسطة كمبوبوكس( القائمة المنسدلة) يرجى ايضاح مكان الخطأ في الكود مع خالص تقديري   اليكم المثال

المشاركين.rar

[lionheart]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh As Long, v As Long, r As Long, lr As Long, i As Long, ii As Long
    If Target.Address = "$Q$4" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            Range("A10:T60000") = ""
            sh = Worksheets.Count: v = 10
            For r = 1 To sh
                If Sheets(r).Name <> ActiveSheet.Name Then
                    lr = Sheets(r).Range("i" & Rows.Count).End(xlUp).Row
                    For i = 10 To lr
                        If Range("Q4") = Sheets(r).Cells(i, 9) Then
                            Cells(v, 1).Resize(, 20).Value = Sheets(r).Cells(i, 1).Resize(, 20).Value
                            v = v + 1
                        End If
                    Next i
                End If
            Next r
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

 

[ArefALhakimi]

شكراً لك اخي ووفقكم الله وزادكم علماً