Работа с текстовыми строками. Создание макросов в Excel

Option Explicit
Option Compare Text
 
Sub tt()
    Dim arr, a(), i&, ii&, r As Range
 
    Application.ScreenUpdating = False
 
    arr = Split("шея|окорок|шпик|оковалок|грудка|печень|корейка", "|")
 
    a = [a1].CurrentRegion.Value
    ReDim b(1 To UBound(a), 1 To UBound(arr) + 1)
    For i = 1 To UBound(a)
        For ii = 0 To UBound(arr)
            If InStr(a(i, 1), arr(ii)) Then:  b(i, ii + 1) = 1: Exit For:
        Next
    Next
    [c1].Resize(UBound(b, 1), UBound(b, 2)) = b
 
    On Error Resume Next
    With ActiveSheet
        For i = 0 To UBound(arr)
            Set r = .Columns(3 + i).SpecialCells(xlCellTypeConstants).EntireRow
            If Err = 0 Then
                Sheets.Add.Name = arr(i)
                r.Copy Sheets(arr(i)).[a1]
                Sheets(arr(i)).Columns(3 + i).Cells(1).Resize(UBound(b)).Clear
            End If
            Err.Clear
        Next
        .[c1].Resize(UBound(b, 1), UBound(b, 2)).Clear
    End With
 
    Application.ScreenUpdating = True
 
End Sub

If InStr(a(i, 1), arr(ii)) Then:  b(i, 1) = arr(ii): Exit For