Sub xs()
    Application.ScreenUpdating = False
    'очистим старый список
    a = Cells(Rows.Count, "k").End(xlUp).Row 'нижняя ячейка списка
    If a > 3 Then Range("k4:l" & a).Clear
    'определим размеры* таблицы на листе Рецепты
    b = Sheets("Рецепты").Cells(Rows.Count, "b").End(xlUp).Row          'нижняя строка
    c = Sheets("Рецепты").Cells(4, Columns.Count).End(xlToLeft).Column  'правый столбец
    'определим диапазон недели
    d = Range("m2").Value
    e = Application.Match(d, Range("a:a"), 0)           'верхняя строка
    f = Range("a" & e).MergeArea.Cells.Count + e - 1    'нижняя строка
    'пройдемся циклом по неделе
    For Each g In Range("b" & e & ":h" & f)
        h = g.Value 'значение ячейки
        If h <> "" Then
            i = Application.Match(h, Sheets("Рецепты").Range("b1:b" & b), 0) 'строка блюда
            j = Application.Count(Range(Sheets("Рецепты").Cells(i, 3), Sheets("Рецепты").Cells(i, c))) 'кол-во инг.
            'вытащим ингридиенты
            If j > 0 Then
                k = 2 'начальный столбец
                For l = 1 To j
                    m = Sheets("Рецепты").Cells(i, k).End(xlToRight).Column 'столбец со значанием
                    n = Sheets("Рецепты").Cells(i, m).Value 'вес*
                    o = Sheets("Рецепты").Cells(4, m).Value 'наименование
                    p = Cells(Rows.Count, "k").End(xlUp).Row + 1    'строка вставки (1)
                    q = Application.Match(o, Range("k4:k" & p), 0)  'строка вставки (2)
                    If IsNumeric(q) Then
                        q = q + 3
                        Range("l" & q) = Range("l" & q).Value + n
                    Else
                        Range("k" & p) = o
                        Range("l" & p) = n
                    End If
                    k = m '
                Next
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub