Public Sub www()
    Dim i&, ws As Worksheet, a, n&
    Set ws = Sheets("КОМПЛЕКС 180-1")
    a = ws.Range("a1:c" & ws.[b65536].End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 8)
    For i = 2 To UBound(a)
        If InStr(a(i, 1), " ") Then
            On Error Resume Next
            If CDate(Split(a(i, 1))(1)) > 0 Then
                If Err Then
                    Err.Clear: On Error GoTo 0
                Else
                    n = n + 1: b(n, 1) = CDate(Split(a(i, 1))(1))
                End If


            End If
        Else
            If InStr(1, " СалатПервоеВтороеЕщё гарнир", a(i, 1)) > 1 Then
                b(n, 2) = a(i, 1)
            ElseIf (a(i, 2) <> Empty) And (IsNumeric(a(i, 1))) And a(i, 1) > 0 Then
                If a(i, 1) <> b(n, 3) Then n = n + 1: b(n, 2) = b(n - 1, 2): b(n, 1) = b(n - 1, 1)
                b(n, 3) = a(i, 1): b(n, 4) = a(i, 2) & ":" & a(i + 1, 2): b(n, 6) = a(i, 3): b(n, 7) = a(i + 1, 3)
            Else
                If (a(i, 1) = Empty) And (a(i, 2) = Empty) Then b(n, 8) = a(i, 3)
            End If
        End If
    Next
    Sheets("Таблица").[a1].CurrentRegion.Offset(1).ClearContents
    Sheets("Таблица").[a2].Resize(n, 8) = b
    On Error Resume Next
    Sheets("Таблица").[a1].CurrentRegion.Columns(3).SpecialCells(4).EntireRow.Delete
    On Error GoTo 0
End Sub

Public Sub www()
    Dim i&, ws As Worksheet, a, n&, d As Date, blyd$
    Sheets("Таблица").[a1].CurrentRegion.Offset(1).ClearContents
    Set ws = Sheets("КОМПЛЕКС 180-2")
    a = ws.Range("a1:c" & ws.[b65536].End(xlUp).Row).Value
    ReDim b(1 To UBound(a), 1 To 8)
    For i = 2 To UBound(a)
        If a(i, 1) Like "*##.##.####" Then
            If CDate(Split(a(i, 1))(1)) > 0 Then
                d = CDate(Split(a(i, 1))(1))
            End If
        End If
        If InStr(1, " СалатПервоеВтороеЕщё гарнир", a(i, 1)) > 1 Then blyd = a(i, 1)
        If (a(i, 2) <> Empty) And (IsNumeric(a(i, 1))) And a(i, 1) > 0 Then
            n = n + 1: b(n, 1) = d: b(n, 2) = blyd
            b(n, 3) = a(i, 1): b(n, 4) = a(i, 2) & ":" & a(i + 1, 2): b(n, 6) = a(i, 3): b(n, 7) = a(i + 1, 3)
        Else
            If (a(i, 1) = Empty) And (a(i, 2) = Empty) Then b(n, 8) = a(i, 3)
        End If
    Next
    Sheets("Таблица").[a2].Resize(n, 8) = b
End Sub