Sub Grusha()
    
    Set R = ThisWorkbook.ActiveSheet.Range("D9:G19")
    S = ThisWorkbook.ActiveSheet.Range("L9:L9").Cells(1, 1).Value
    Set Target = ThisWorkbook.ActiveSheet.Range("L9:O19")

    For j = 2 To R.Columns.Count
        Counter = 0
        SS = ""
        RRC = R.Rows.Count
        For i = 1 To RRC
            If InStr(S, R.Cells(i, j - 1).Value) > 0 Then
                    If InStr(SS, R.Cells(i, j).Value) = 0 Then
                        Counter = Counter + 1
                        Target.Cells(Counter, j).Value = R.Cells(i, j).Value
                        SS = SS & "#" & R.Cells(i, j).Value
                    End If
            End If
        Next i
        S = SS
    Next j
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("L9")) Is Nothing Then
Call Grusha
End If
End Sub

            If InStr(S, R.Cells(i, j - 1).Value) > 0 Then
                    If InStr(SS, R.Cells(i, j).Value) = 0 Then


            If InStr(S, R.Cells(i, j - 1).Value & "#") > 0 Then
                    If InStr(SS, R.Cells(i, j).Value & "#") = 0 Then