السلام عليكم
يصبح الكود بهذا الشكل
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Address = Range("C2").Address Then Exit Sub
''''''''''''''''''
Dim Lr As Long, i As Long, R As Long, x As Byte
Dim txt
Range("A6:F" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents
Application.ScreenUpdating = False
txt = Trim(Target)
If Len(txt) < 3 Then Exit Sub
With Sheets("Data")
Lr = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = Lr To 2 Step -1
For x = 1 To 8
If txt = CStr(.Cells(i, x)) Then
Cells(R + 6, "A").Resize(1, 3).Value = .Cells(i, "A").Resize(1, 3).Value
Cells(R + 6, "D").Resize(1, 2).Value = .Cells(i, "E").Resize(1, 2).Value
Cells(R + 6, "F").Value = .Cells(i, "H").Value
R = R + 1
End If
Next
Next
End With
Application.ScreenUpdating = True
End Sub