اخي صلاح
تمام الحمد لله ضع فقط Exit sub في الكود في منتصف الكود تقريبا وقبل السطر التالي
End if
If Target.Column = 8 And Target.Row > 3 And Target <> "" Then
ليكون الكود بالشكل التالي ولو فيه اي شيئ اخبرني
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 4 And Target.Row > 3 And Target <> "" Then
If Range("B4") = "" Then
m = 4
Else
m = Range("B3").End(xlDown).Row
n = Target.Row
End If
v = Application.WorksheetFunction.CountIf(Range("B4:B" & m), Target.Text)
If v = 0 Then
With Columns(2).Rows(500).End(xlUp)
.Offset(1, 0) = Target
End With
m = Range("B3").End(xlDown).Row
s = Range("B4").Address
ss = Cells(m, 2).Address
ActiveWorkbook.Names.Add Name:="Rng", RefersTo:="=" & ActiveSheet.Name & "!" & Range(s, ss).Address
End If
Exit Sub
End If
If Target.Column = 8 And Target.Row > 3 And Target <> "" Then
If Selection.Columns.Count > 1 Then Exit Sub
Cells(Target.Row, Target.Column + 1) = ""
m = Range("D3").End(xlDown).Row
For i = 4 To m
If Cells(i, 4) = Target Then
If Cells(Target.Row, Target.Column + 1) = "" Then 'or i < m Then
Cells(Target.Row, Target.Column + 1) = Cells(i, 5)
Else
Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column + 1) & " " & "¡" & " " & Cells(i, 5)
End If
End If
Next
End If