Private Sub Worksheet_Change(ByVal Target As Range)
Dim L&, R&, S$(), V
If Target.Address = "$A$8" Then
L = 11
Application.EnableEvents = False
Cells(L, 1).CurrentRegion.Clear
If Not IsEmpty(Target) Then
Application.ScreenUpdating = False
With [A1].CurrentRegion.Rows
For R = 2 To .Count
S = Split(.Item(R).Cells(2).Text, "; ")
V = Application.Match("*" & Target.Text & "*", S, 0)
If IsNumeric(V) Then
.Item(R).Copy Cells(L, 1)
Cells(L, 2).Value2 = S(V - 1)
L = L + 1
End If
Next
End With
Application.ScreenUpdating = True
End If
Application.EnableEvents = True
End If
End Sub