Sub uuu()
    Dim a()
    Dim i&, rw&
    Dim sd As Object
    Dim k
'---------------------
    a = Sheets("Таблица").UsedRange.Value
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(a)
        k = a(i, 3)
        If k <> "" Then sd.Item(k) = sd.Item(k) + 1
    Next
    rw = 2
    For Each k In sd.Keys
        If sd.Item(k) = 1 Then
            For i = 2 To UBound(a)
                If a(i, 3) = k Then
                    If InStr("OIU,IUH,TOW,DLV", a(i, 5)) > 0 Then
                        Sheets("Вставка").Cells(rw, 1).Resize(1, UBound(a, 2)) = WorksheetFunction.Index(a, i)
                        rw = rw + 1
                    End If
                End If
            Next
        End If
    Next
    Beep
    MsgBox "Готово!"
End Sub