Sub Макрос1()
Dim r As Range ' Пусть r - диапазон ячеек
Set RE = CreateObject("VBScript.RegExp") 'создать регулярно выражение вида "найти текст"
RE.Pattern = "^(\d{2})\.?(\.[а-яА-ЯёЁa-zA-Z0-9]{2})*\s" 'Прописать в RE шаблон строки поиска по правилам регулярного выражения
For Each r In Range(Cells(3, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)) 'искать в каждой строке диапазона
    If RE.Test(r) Then 'если шаблон RE в диапазоне r найден
        m = RE.Execute(r).Item(0) 'записать в m значение шаблона RE
    Else
        r.Offset(0, 3) = r 'номер столбца, куда вставить артикул
        r.Offset(0, 4) = m 'номер столбца, куда вставить товарную группу
    End If
Next r
End Sub

Sub Filter()

Worksheets.Add.Name = "раос_гп_291_4000" 'Создание нового листа

Worksheets("Ввод").Range("A5:O33").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Лист1").Range("S13:V14"), _
CopyToRange:=Worksheets("раос_гп_291_4000").Range("A1:O33"), Unique:=False

Worksheets.Add.Name = "раос_гп_291_8000" 'Создание нового листа

Worksheets("Ввод").Range("A5:O33").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Worksheets("Лист1").Range("S15:V16"), _
CopyToRange:=Worksheets("раос_гп_291_8000").Range("A1:O33"), Unique:=False

End Sub

CriteriaRange:=Worksheets("Лист1").Range("S15:V16"), _
If Worksheets("Ввод").Range("A5:O33") <> "" then
Worksheets.Add.Name = "Раос_гп_291_8000" 'Создание нового листа
Worksheets("Ввод").Range("A5:O33"), CopyToRange:=Worksheets("Раос_гп_291_8000").Range("A1:O33"), Unique:=False

Sub МЯУ()
    Dim oDic As Object, i&
    Dim arr, oDicItems
    Set oDic = CreateObject("Scripting.Dictionary")
    arr = [A1].CurrentRegion.Value
    For i = 2 To UBound(arr)
        oDic.Item (Application.Trim(arr(i, 5)) & "|" & Application.Trim(arr(i, 6)) = Application.Trim(arr(i, 6)) & "|" & Application.Trim(arr(i, 5)))
        'oDic.Item(arr(i, 5) & "|" & arr(i, 6)) = arr(i, 6) & "|" & arr(i, 5)
    Next
    oDicItems = oDic.Items
    For i = 0 To UBound(oDicItems)
        If oDic.Exists(oDicItems(i)) Then
            Cells(i + 2, 5).Resize(, 2).Interior.Color = vbRed
        End If
    Next
End Sub

Sub test() 
Dim cell As Range: Set cell = Range("qwer").Find(5, , xlValues) 
If Not cell Is Nothing Then MsgBox "Число 5 найдено в ячейке " & cell.Address 
End Sub

Sub УдалениеСтрокПоНесколькимУсловиям()
    Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' ищем и удаляем строки, содержащие заданный текст
   ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
   УдалятьСтрокиСТекстом = Array("Наименование *", "Количество", _
                                  "текст?", "цен*сти", "*78*")

    ' перебираем все строки в используемом диапазоне листа
   For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
       For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
           If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                ' добавляем строку в диапазон для удаления
               If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next

    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
   If Not delra Is Nothing Then delra.EntireRow.Hidden = True    ' скрываем их
   If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
End Sub