Option Explicit ' ===============================...

Да. Причина у тебя именно в этой логике:

vb
If CanAllRemainingFitInOnePlate(...) Then

Сейчас дополнительный слеб берётся только тогда, когда в него помещаются вообще все оставшиеся детали. Поэтому для Столешница 2 = 1200 x 600 макрос видит, что все остальные детали в один доп. слеб не входят, и сразу открывает Основной слеб 2.

Ниже изменённая логика: когда нужна новая плита, макрос сначала пытается взять самый маленький доступный дополнительный слеб, в который помещается текущая деталь: 0,25 → 0,5 → 0,75. Каждый дополнительный слеб по-прежнему можно использовать максимум один раз. Основной слеб создаётся только если текущая деталь не помещается ни в один ещё не использованный дополнительный.

В твоём примере Столешница 2 = 1200 x 600 не входит в 0,25 = 920 x 760, но входит в 0,5 = 1840 x 760, поэтому вместо Основной слеб 2 будет создан Доп. слеб 0,5.

Замени весь модуль на этот вариант:

vb
Option Explicit

' =========================================================
' РАСКРОЙ "ПОЛОСАМИ ПО ДЛИНЕ ПЛИТЫ"
' ВЕРСИЯ ДЛЯ РАСЧЕТА П-ОБРАЗНЫЙ
'
' ЛОГИКА ДОП. СЛЕБОВ:
' 1) Доп. 0,25 - максимум 1 шт.
' 2) Доп. 0,5  - максимум 1 шт.
' 3) Доп. 0,75 - максимум 1 шт.
'
' Если нужна НОВАЯ плита:
' сначала пробуем самый маленький доступный доп. слеб,
' в который помещается ТЕКУЩАЯ деталь:
'
'     0,25 -> 0,5 -> 0,75 -> основной
'
' То есть больше НЕ требуется, чтобы ВСЕ оставшиеся детали
' помещались в одну дополнительную плиту.
' =========================================================

Private Const EDGE_W As Long = 50

Private Enum ePlateType
    PlateMain = 1
    Plate075 = 2
    PlateHalf = 3
    PlateQuarter = 4
End Enum

Private Type tPiece
    Part As String
    L As Long
    W As Long
End Type

Private Type tStrip
    W As Long
    UsedL As Long
    PieceCount As Long
    Pieces() As tPiece
End Type

Private Type tPlate
    PlateLabel As String
    plateType As ePlateType
    L As Long
    W As Long
    RemainingW As Long
    StripCount As Long
    Strips() As tStrip
End Type


' =========================================================
' ОСНОВНОЙ РАСЧЕТ
' =========================================================

Public Sub CalculateSlabsV3()

    Dim ws As Worksheet

    Dim L_main As Long
    Dim W_main As Long

    Dim L_075 As Long
    Dim W_075 As Long

    Dim L_half As Long
    Dim W_half As Long

    Dim L_quarter As Long
    Dim W_quarter As Long

    Dim L_stol As Long
    Dim W_stol As Long

    Dim L_stol2 As Long
    Dim W_stol2 As Long

    Dim L_stol3 As Long
    Dim W_stol3 As Long

    Dim includePanels As Boolean
    Dim includeSidePanels As Boolean
    Dim includeEdges As Boolean
    Dim includePodkleika As Boolean

    Dim ak4Val As Double

    On Error GoTo ObrabotchikOshibki

    Set ws = ThisWorkbook.Sheets("Расчет П-образный")


    ' =====================================================
    ' ФЛАГИ
    ' =====================================================

    includePanels = IsTrueCell(ws.Range("E2").Value)
    includeSidePanels = IsTrueCell(ws.Range("E3").Value)
    includePodkleika = IsTrueCell(ws.Range("E4").Value)


    ' =====================================================
    ' РАЗМЕРЫ СЛЕБОВ
    ' =====================================================

    ' основной
    L_main = ReadMm(ws, "B7")
    W_main = ReadMm(ws, "B8")

    ' доп. 0,75
    L_075 = ReadMmOptional(ws, "B9")
    W_075 = ReadMmOptional(ws, "B10")

    If L_075 <= 0 Or W_075 <= 0 Then
        L_075 = 0
        W_075 = 0
    End If

    ' доп. 0,5
    L_half = ReadMmOptional(ws, "B11")
    W_half = ReadMmOptional(ws, "B12")

    If L_half <= 0 Or W_half <= 0 Then
        L_half = 0
        W_half = 0
    End If

    ' доп. 0,25
    L_quarter = ReadMmOptional(ws, "B13")
    W_quarter = ReadMmOptional(ws, "B14")

    If L_quarter <= 0 Or W_quarter <= 0 Then
        L_quarter = 0
        W_quarter = 0
    End If


    ' =====================================================
    ' СТОЛЕШНИЦЫ
    ' =====================================================

    ' столешница 1
    L_stol = ReadMm(ws, "O20")
    W_stol = ReadMm(ws, "N21")

    ' столешница 2
    L_stol2 = ReadMmOptional(ws, "N29")
    W_stol2 = ReadMmOptional(ws, "O39")

    If L_stol2 <= 0 Or W_stol2 <= 0 Then
        L_stol2 = 0
        W_stol2 = 0
    End If

    ' столешница 3
    L_stol3 = ReadMmOptional(ws, "AF29")
    W_stol3 = ReadMmOptional(ws, "AA39")

    If L_stol3 <= 0 Or W_stol3 <= 0 Then
        L_stol3 = 0
        W_stol3 = 0
    End If


    If L_main <= 0 Or W_main <= 0 Or _
       L_stol <= 0 Or W_stol <= 0 Then

        MsgBox "Ошибка: размеры основного сляба и основной столешницы должны быть больше 0 мм.", vbExclamation
        Exit Sub
    End If


    ' =====================================================
    ' ТОРЦЫ
    ' =====================================================

    ak4Val = ParseMmToDouble(ws.Range("AY5").Value)

    includeEdges = (Abs(ak4Val - 12#) > 0.0001)

    If includeEdges Then

        If EDGE_W > W_main Then

            MsgBox "Ошибка: ширина торца 50 мм больше ширины основного сляба.", vbExclamation
            Exit Sub

        End If

    End If


    Dim e1L As Long
    Dim e2L As Long
    Dim e3L As Long
    Dim e4L As Long
    Dim e5L As Long
    Dim e6L As Long
    Dim e7L As Long
    Dim e8L As Long


    If includeEdges Then

        e1L = ReadMmOptional(ws, "O30")
        e2L = ReadMmOptional(ws, "T21")
        e3L = ReadMmOptional(ws, "AE30")
        e4L = ReadMmOptional(ws, "AC38")
        e5L = ReadMmOptional(ws, "AA32")
        e6L = ReadMmOptional(ws, "W28")
        e7L = ReadMmOptional(ws, "S32")
        e8L = ReadMmOptional(ws, "Q38")

    Else

        e1L = 0
        e2L = 0
        e3L = 0
        e4L = 0
        e5L = 0
        e6L = 0
        e7L = 0
        e8L = 0

    End If


    ' =====================================================
    ' ПОДКЛЕЙКА ТОРЦОВ
    ' =====================================================

    Dim pk1L As Long
    Dim pk1W As Long

    Dim pk2L As Long
    Dim pk2W As Long

    Dim pk3L As Long
    Dim pk3W As Long

    Dim pk4L As Long
    Dim pk4W As Long

    Dim pk5L As Long
    Dim pk5W As Long

    Dim pk6L As Long
    Dim pk6W As Long

    Dim pk7L As Long
    Dim pk7W As Long

    Dim pk8L As Long
    Dim pk8W As Long


    If includePodkleika Then

        pk1L = ReadMmOptional(ws, "J21")
        pk1W = ReadMmOptional(ws, "K38")

        pk2L = ReadMmOptional(ws, "O17")
        pk2W = ReadMmOptional(ws, "N18")

        pk3L = ReadMmOptional(ws, "AJ21")
        pk3W = ReadMmOptional(ws, "AI39")

        pk4L = ReadMmOptional(ws, "AA42")
        pk4W = ReadMmOptional(ws, "AF41")

        pk5L = ReadMmOptional(ws, "X32")
        pk5W = ReadMmOptional(ws, "Y38")

        pk6L = ReadMmOptional(ws, "T31")
        pk6W = ReadMmOptional(ws, "Z30")

        pk7L = ReadMmOptional(ws, "V32")
        pk7W = ReadMmOptional(ws, "U38")

        pk8L = ReadMmOptional(ws, "O42")
        pk8W = ReadMmOptional(ws, "N41")

    Else

        pk1L = 0: pk1W = 0
        pk2L = 0: pk2W = 0
        pk3L = 0: pk3W = 0
        pk4L = 0: pk4W = 0
        pk5L = 0: pk5W = 0
        pk6L = 0: pk6W = 0
        pk7L = 0: pk7W = 0
        pk8L = 0: pk8W = 0

    End If


    ' =====================================================
    ' ОЧИСТКА СТАРОЙ РАСКЛАДКИ
    ' =====================================================

    ClearLayout ws, ws.Range("BE1")


    ' =====================================================
    ' СОБИРАЕМ ВСЕ ДЕТАЛИ
    ' =====================================================

    Dim lens() As Long
    Dim wids() As Long
    Dim names() As String

    Dim n As Long

    n = 0

    ReDim lens(1 To 1)
    ReDim wids(1 To 1)
    ReDim names(1 To 1)


    ' Максимальная ширина части.
    '
    ' Берем минимальную положительную ширину среди всех плит,
    ' чтобы кусок по ширине мог физически войти и в доп. плиту.
    Dim splitW As Long

    splitW = MinPositive4( _
                    W_main, _
                    W_075, _
                    W_half, _
                    W_quarter)

    If splitW <= 0 Then splitW = W_main


    ' =====================================================
    ' СТОЛЕШНИЦЫ
    ' =====================================================

    AppendPiecesNamedSplitWH _
        lens, wids, names, n, _
        L_stol, W_stol, _
        L_main, splitW, _
        "Столешница 1"


    If L_stol2 > 0 And W_stol2 > 0 Then

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            L_stol2, W_stol2, _
            L_main, splitW, _
            "Столешница 2"

    End If


    If L_stol3 > 0 And W_stol3 > 0 Then

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            L_stol3, W_stol3, _
            L_main, splitW, _
            "Столешница 3"

    End If


    ' =====================================================
    ' СТЕНОВЫЕ ПАНЕЛИ
    ' =====================================================

    Dim p1L As Long, p1W As Long
    Dim p2L As Long, p2W As Long
    Dim p3L As Long, p3W As Long
    Dim p4L As Long, p4W As Long
    Dim p5L As Long, p5W As Long


    If includePanels Then

        p1L = ReadMm(ws, "G21")
        p1W = ReadMm(ws, "H38")

        p2L = ReadMm(ws, "O13")
        p2W = ReadMm(ws, "N14")

        p3L = ReadMm(ws, "AN21")
        p3W = ReadMm(ws, "AM38")

        p4L = ReadMm(ws, "O48")
        p4W = ReadMm(ws, "N44")

        p5L = ReadMm(ws, "AA48")
        p5W = ReadMm(ws, "AG44")


        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            p1L, p1W, L_main, splitW, _
            "Стеновая панель 1"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            p2L, p2W, L_main, splitW, _
            "Стеновая панель 2"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            p3L, p3W, L_main, splitW, _
            "Стеновая панель 3"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            p4L, p4W, L_main, splitW, _
            "Стеновая панель 4"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            p5L, p5W, L_main, splitW, _
            "Стеновая панель 5"

    End If


    ' =====================================================
    ' БОКОВЫЕ ПАНЕЛИ
    ' =====================================================

    Dim s1L As Long, s1W As Long
    Dim s2L As Long, s2W As Long
    Dim s3L As Long, s3W As Long


    If includeSidePanels Then

        s1L = ReadMm(ws, "C21")
        s1W = ReadMm(ws, "D38")

        s2L = ReadMm(ws, "O7")
        s2W = ReadMm(ws, "N8")

        s3L = ReadMm(ws, "AS21")
        s3W = ReadMm(ws, "AQ38")


        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            s1L, s1W, L_main, splitW, _
            "Боковая панель 1"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            s2L, s2W, L_main, splitW, _
            "Боковая панель 2"

        AppendPiecesNamedSplitWH _
            lens, wids, names, n, _
            s3L, s3W, L_main, splitW, _
            "Боковая панель 3"

    End If


    ' =====================================================
    ' ТОРЦЫ
    ' =====================================================

    If includeEdges Then

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e1L, EDGE_W, L_main, splitW, "Торец 1"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e2L, EDGE_W, L_main, splitW, "Торец 2"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e3L, EDGE_W, L_main, splitW, "Торец 3"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e4L, EDGE_W, L_main, splitW, "Торец 4"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e5L, EDGE_W, L_main, splitW, "Торец 5"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e6L, EDGE_W, L_main, splitW, "Торец 6"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e7L, EDGE_W, L_main, splitW, "Торец 7"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            e8L, EDGE_W, L_main, splitW, "Торец 8"

    End If


    ' =====================================================
    ' ПОДКЛЕЙКИ
    ' =====================================================

    If includePodkleika Then

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk1L, pk1W, L_main, splitW, "Подклейка торца 1"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk2L, pk2W, L_main, splitW, "Подклейка торца 2"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk3L, pk3W, L_main, splitW, "Подклейка торца 3"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk4L, pk4W, L_main, splitW, "Подклейка торца 4"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk5L, pk5W, L_main, splitW, "Подклейка торца 5"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk6L, pk6W, L_main, splitW, "Подклейка торца 6"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk7L, pk7W, L_main, splitW, "Подклейка торца 7"

        AppendPiecesNamedSplitWH lens, wids, names, n, _
            pk8L, pk8W, L_main, splitW, "Подклейка торца 8"

    End If


    ' =====================================================
    ' СОРТИРОВКА
    ' =====================================================

    If n > 0 Then
        SortPiecesByWidthDescThenLenDesc _
            lens, wids, names, n
    End If


    ' =====================================================
    ' РАСКЛАДКА
    ' =====================================================

    Dim plates() As tPlate
    Dim plateCount As Long

    Dim mainCount As Long
    Dim count075 As Long
    Dim halfCount As Long
    Dim quarterCount As Long


    plateCount = 0
    mainCount = 0
    count075 = 0
    halfCount = 0
    quarterCount = 0

    ReDim plates(1 To 1)


    Dim i As Long

    For i = 1 To n

        If lens(i) > 0 And wids(i) > 0 Then

            PlacePieceSmart _
                plates, _
                plateCount, _
                mainCount, _
                count075, _
                halfCount, _
                quarterCount, _
                lens, _
                wids, _
                names, _
                i, _
                L_main, _
                W_main, _
                L_075, _
                W_075, _
                L_half, _
                W_half, _
                L_quarter, _
                W_quarter

        End If

    Next i


    ' =====================================================
    ' КОЛИЧЕСТВО СЛЕБОВ
    ' =====================================================

    ws.Range("B17").Value = mainCount
    ws.Range("B18").Value = count075
    ws.Range("B19").Value = halfCount
    ws.Range("B20").Value = quarterCount


    ' =====================================================
    ' ВЫВОД РАСКЛАДКИ
    ' =====================================================

    DumpLayoutDetailed _
        ws, _
        plates, _
        plateCount, _
        ws.Range("BE1")


    ' =====================================================
    ' ИНФОРМАЦИЯ
    ' =====================================================

    Dim infoText As String

    infoText = _
        "РАСЧЕТ П-ОБРАЗНЫЙ ЗАВЕРШЕН!" & _
        vbCrLf & vbCrLf & _
        "Основных слебов: " & mainCount & vbCrLf & _
        "Доп. слеб 0,75: " & count075 & vbCrLf & _
        "Доп. слеб 0,5: " & halfCount & vbCrLf & _
        "Доп. слеб 0,25: " & quarterCount & vbCrLf & vbCrLf & _
        "Основной сляб: " & _
        L_main & " x " & W_main & " мм"


    If L_075 > 0 And W_075 > 0 Then
        infoText = infoText & vbCrLf & _
            "Доп. 0,75: " & L_075 & " x " & W_075 & " мм"
    Else
        infoText = infoText & vbCrLf & _
            "Доп. 0,75: не задан"
    End If


    If L_half > 0 And W_half > 0 Then
        infoText = infoText & vbCrLf & _
            "Доп. 0,5: " & L_half & " x " & W_half & " мм"
    Else
        infoText = infoText & vbCrLf & _
            "Доп. 0,5: не задан"
    End If


    If L_quarter > 0 And W_quarter > 0 Then
        infoText = infoText & vbCrLf & _
            "Доп. 0,25: " & L_quarter & " x " & W_quarter & " мм"
    Else
        infoText = infoText & vbCrLf & _
            "Доп. 0,25: не задан"
    End If


    infoText = infoText & vbCrLf & _
        "Столешница 1: " & _
        L_stol & " x " & W_stol & " мм"


    If L_stol2 > 0 And W_stol2 > 0 Then

        infoText = infoText & vbCrLf & _
            "Столешница 2: " & _
            L_stol2 & " x " & W_stol2 & " мм"

    Else

        infoText = infoText & vbCrLf & _
            "Столешница 2: не задана"

    End If


    If L_stol3 > 0 And W_stol3 > 0 Then

        infoText = infoText & vbCrLf & _
            "Столешница 3: " & _
            L_stol3 & " x " & W_stol3 & " мм"

    Else

        infoText = infoText & vbCrLf & _
            "Столешница 3: не задана"

    End If


    infoText = infoText & _
        vbCrLf & "E2 (стеновые панели): " & ws.Range("E2").Value & _
        vbCrLf & "E3 (боковые панели): " & ws.Range("E3").Value & _
        vbCrLf & "E4 (подклейка торцов): " & ws.Range("E4").Value & _
        vbCrLf & "AY5: " & ws.Range("AY5").Value


    If includeEdges Then
        infoText = infoText & "  (торцы ДОБАВЛЕНЫ)"
    Else
        infoText = infoText & "  (торцы НЕ добавляем)"
    End If


    MsgBox _
        infoText, _
        vbInformation, _
        "Результат расчета П-образный"

    Exit Sub


ObrabotchikOshibki:

    MsgBox _
        "Ошибка при расчёте П-образный." & vbCrLf & vbCrLf & _
        "Описание:" & vbCrLf & _
        Err.Description & vbCrLf & vbCrLf & _
        "Проверьте размеры деталей и слебов.", _
        vbCritical

End Sub


' =========================================================
' СОРТИРОВКА
' =========================================================

Private Sub SortPiecesByWidthDescThenLenDesc( _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByVal n As Long)

    If n <= 1 Then Exit Sub

    QuickSortPiecesNew _
        lens, wids, names, 1, n

End Sub


Private Sub QuickSortPiecesNew( _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByVal lo As Long, _
    ByVal hi As Long)

    Dim i As Long
    Dim j As Long

    Dim pivotW As Long
    Dim pivotL As Long

    i = lo
    j = hi

    pivotW = wids((lo + hi) \ 2)
    pivotL = lens((lo + hi) \ 2)


    Do While i <= j

        Do While _
            (wids(i) > pivotW) Or _
            (wids(i) = pivotW And lens(i) > pivotL)

            i = i + 1

        Loop


        Do While _
            (wids(j) < pivotW) Or _
            (wids(j) = pivotW And lens(j) < pivotL)

            j = j - 1

        Loop


        If i <= j Then

            SwapPiece _
                lens, wids, names, i, j

            i = i + 1
            j = j - 1

        End If

    Loop


    If lo < j Then
        QuickSortPiecesNew _
            lens, wids, names, lo, j
    End If

    If i < hi Then
        QuickSortPiecesNew _
            lens, wids, names, i, hi
    End If

End Sub


Private Sub SwapPiece( _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByVal a As Long, _
    ByVal b As Long)

    Dim tL As Long
    Dim tW As Long
    Dim tN As String

    tL = lens(a)
    tW = wids(a)
    tN = names(a)

    lens(a) = lens(b)
    wids(a) = wids(b)
    names(a) = names(b)

    lens(b) = tL
    wids(b) = tW
    names(b) = tN

End Sub


' =========================================================
' УМНАЯ УКЛАДКА
' =========================================================

Private Sub PlacePieceSmart( _
    ByRef plates() As tPlate, _
    ByRef plateCount As Long, _
    ByRef mainCount As Long, _
    ByRef count075 As Long, _
    ByRef halfCount As Long, _
    ByRef quarterCount As Long, _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByVal idx As Long, _
    ByVal L_main As Long, _
    ByVal W_main As Long, _
    ByVal L_075 As Long, _
    ByVal W_075 As Long, _
    ByVal L_half As Long, _
    ByVal W_half As Long, _
    ByVal L_quarter As Long, _
    ByVal W_quarter As Long)


    Dim pieceL As Long
    Dim pieceW As Long
    Dim partName As String

    pieceL = lens(idx)
    pieceW = wids(idx)
    partName = names(idx)


    Dim i As Long
    Dim s As Long


    ' =====================================================
    ' 1. СНАЧАЛА ПЫТАЕМСЯ В СУЩЕСТВУЮЩИЕ ПОЛОСЫ
    ' =====================================================

    For i = 1 To plateCount

        For s = 1 To plates(i).StripCount

            If plates(i).Strips(s).W >= pieceW Then

                If plates(i).Strips(s).UsedL + pieceL <= plates(i).L Then

                    plates(i).Strips(s).UsedL = _
                        plates(i).Strips(s).UsedL + pieceL

                    AddPieceToStrip _
                        plates(i).Strips(s), _
                        partName, _
                        pieceL, _
                        pieceW

                    Exit Sub

                End If

            End If

        Next s

    Next i


    ' =====================================================
    ' 2. НОВАЯ ПОЛОСА В УЖЕ СУЩЕСТВУЮЩЕЙ ПЛИТЕ
    ' =====================================================

    Dim bestPlate As Long
    Dim bestRemAfter As Long
    Dim remAfter As Long

    bestPlate = 0
    bestRemAfter = 0


    For i = 1 To plateCount

        If pieceL <= plates(i).L And _
           plates(i).RemainingW >= pieceW Then

            remAfter = _
                plates(i).RemainingW - pieceW

            If bestPlate = 0 Or _
               remAfter < bestRemAfter Then

                bestPlate = i
                bestRemAfter = remAfter

            End If

        End If

    Next i


    If bestPlate <> 0 Then

        AddStripAndPlace _
            plates(bestPlate), _
            pieceW, _
            pieceL, _
            pieceW, _
            partName

        Exit Sub

    End If


    ' =====================================================
    ' 3. НУЖНА НОВАЯ ПЛИТА
    '
    ' ВАЖНО:
    ' теперь НЕ проверяем "все оставшиеся детали".
    '
    ' Проверяем только:
    ' помещается ли ТЕКУЩАЯ деталь в доступный доп. слеб.
    '
    ' Приоритет:
    ' 0,25 -> 0,5 -> 0,75 -> основной
    ' =====================================================

    Dim chosenType As ePlateType

    chosenType = ChooseNewPlateTypeForPiece( _
                        pieceL, _
                        pieceW, _
                        L_075, _
                        W_075, _
                        count075, _
                        L_half, _
                        W_half, _
                        halfCount, _
                        L_quarter, _
                        W_quarter, _
                        quarterCount)


    Select Case chosenType

        Case PlateQuarter

            AddNewPlate _
                plates, _
                plateCount, _
                mainCount, _
                count075, _
                halfCount, _
                quarterCount, _
                L_quarter, _
                W_quarter, _
                PlateQuarter


        Case PlateHalf

            AddNewPlate _
                plates, _
                plateCount, _
                mainCount, _
                count075, _
                halfCount, _
                quarterCount, _
                L_half, _
                W_half, _
                PlateHalf


        Case Plate075

            AddNewPlate _
                plates, _
                plateCount, _
                mainCount, _
                count075, _
                halfCount, _
                quarterCount, _
                L_075, _
                W_075, _
                Plate075


        Case Else

            ' Только если ни один доступный дополнительный
            ' слеб не может принять текущую деталь.
            AddNewPlate _
                plates, _
                plateCount, _
                mainCount, _
                count075, _
                halfCount, _
                quarterCount, _
                L_main, _
                W_main, _
                PlateMain

    End Select


    AddStripAndPlace _
        plates(plateCount), _
        pieceW, _
        pieceL, _
        pieceW, _
        partName

End Sub


' =========================================================
' ВЫБОР НОВОЙ ПЛИТЫ
'
' ГЛАВНОЕ ИЗМЕНЕНИЕ В МАКРОСЕ
' =========================================================

Private Function ChooseNewPlateTypeForPiece( _
    ByVal pieceL As Long, _
    ByVal pieceW As Long, _
    ByVal L_075 As Long, _
    ByVal W_075 As Long, _
    ByVal count075 As Long, _
    ByVal L_half As Long, _
    ByVal W_half As Long, _
    ByVal halfCount As Long, _
    ByVal L_quarter As Long, _
    ByVal W_quarter As Long, _
    ByVal quarterCount As Long) As ePlateType


    ' =====================================================
    ' 1. ДОП. 0,25
    ' =====================================================

    If quarterCount = 0 Then

        If PlateCanTakePiece( _
            pieceL, _
            pieceW, _
            L_quarter, _
            W_quarter) Then

            ChooseNewPlateTypeForPiece = PlateQuarter
            Exit Function

        End If

    End If


    ' =====================================================
    ' 2. ДОП. 0,5
    ' =====================================================

    If halfCount = 0 Then

        If PlateCanTakePiece( _
            pieceL, _
            pieceW, _
            L_half, _
            W_half) Then

            ChooseNewPlateTypeForPiece = PlateHalf
            Exit Function

        End If

    End If


    ' =====================================================
    ' 3. ДОП. 0,75
    ' =====================================================

    If count075 = 0 Then

        If PlateCanTakePiece( _
            pieceL, _
            pieceW, _
            L_075, _
            W_075) Then

            ChooseNewPlateTypeForPiece = Plate075
            Exit Function

        End If

    End If


    ' =====================================================
    ' 4. НИ ОДИН ДОП. НЕ ПОДОШЕЛ
    ' =====================================================

    ChooseNewPlateTypeForPiece = PlateMain

End Function


Private Function PlateCanTakePiece( _
    ByVal pieceL As Long, _
    ByVal pieceW As Long, _
    ByVal plateL As Long, _
    ByVal plateW As Long) As Boolean


    PlateCanTakePiece = False


    If plateL <= 0 Then Exit Function
    If plateW <= 0 Then Exit Function

    If pieceL <= 0 Then Exit Function
    If pieceW <= 0 Then Exit Function


    If pieceL <= plateL And _
       pieceW <= plateW Then

        PlateCanTakePiece = True

    End If

End Function


' =========================================================
' ДОБАВЛЕНИЕ НОВОЙ ПЛИТЫ
' =========================================================

Private Sub AddNewPlate( _
    ByRef plates() As tPlate, _
    ByRef plateCount As Long, _
    ByRef mainCount As Long, _
    ByRef count075 As Long, _
    ByRef halfCount As Long, _
    ByRef quarterCount As Long, _
    ByVal L As Long, _
    ByVal W As Long, _
    ByVal plateType As ePlateType)


    plateCount = plateCount + 1


    If plateCount = 1 Then

        ReDim plates(1 To 1)

    Else

        ReDim Preserve plates(1 To plateCount)

    End If


    With plates(plateCount)

        .L = L
        .W = W
        .RemainingW = W

        .StripCount = 0

        Erase .Strips

        .plateType = plateType

    End With


    Select Case plateType


        Case PlateMain

            mainCount = mainCount + 1

            plates(plateCount).PlateLabel = _
                "Основной слеб " & mainCount


        Case Plate075

            If count075 >= 1 Then

                Err.Raise _
                    1100, , _
                    "Нельзя использовать больше 1 дополнительной плиты 0,75."

            End If

            count075 = count075 + 1

            plates(plateCount).PlateLabel = _
                "Доп. слеб 0,75"


        Case PlateHalf

            If halfCount >= 1 Then

                Err.Raise _
                    1101, , _
                    "Нельзя использовать больше 1 дополнительной плиты 0,5."

            End If

            halfCount = halfCount + 1

            plates(plateCount).PlateLabel = _
                "Доп. слеб 0,5"


        Case PlateQuarter

            If quarterCount >= 1 Then

                Err.Raise _
                    1102, , _
                    "Нельзя использовать больше 1 дополнительной плиты 0,25."

            End If

            quarterCount = quarterCount + 1

            plates(plateCount).PlateLabel = _
                "Доп. слеб 0,25"

    End Select

End Sub


' =========================================================
' ДОБАВЛЕНИЕ ПОЛОСЫ
' =========================================================

Private Sub AddStripAndPlace( _
    ByRef pl As tPlate, _
    ByVal stripW As Long, _
    ByVal firstPieceL As Long, _
    ByVal firstPieceW As Long, _
    ByVal partName As String)


    If pl.RemainingW < stripW Then

        Err.Raise _
            1003, , _
            "Недостаточно ширины в плите для полосы " & _
            stripW & " мм."

    End If


    If firstPieceL > pl.L Then

        Err.Raise _
            1005, , _
            "Кусок длиннее длины выбранной плиты."

    End If


    pl.StripCount = pl.StripCount + 1


    If pl.StripCount = 1 Then

        ReDim pl.Strips(1 To 1)

    Else

        ReDim Preserve _
            pl.Strips(1 To pl.StripCount)

    End If


    With pl.Strips(pl.StripCount)

        .W = stripW
        .UsedL = firstPieceL

        .PieceCount = 0

        Erase .Pieces

    End With


    AddPieceToStrip _
        pl.Strips(pl.StripCount), _
        partName, _
        firstPieceL, _
        firstPieceW


    pl.RemainingW = _
        pl.RemainingW - stripW

End Sub


' =========================================================
' ДОБАВЛЕНИЕ ДЕТАЛИ В ПОЛОСУ
' =========================================================

Private Sub AddPieceToStrip( _
    ByRef st As tStrip, _
    ByVal partName As String, _
    ByVal pieceL As Long, _
    ByVal pieceW As Long)


    st.PieceCount = st.PieceCount + 1


    If st.PieceCount = 1 Then

        ReDim st.Pieces(1 To 1)

    Else

        ReDim Preserve _
            st.Pieces(1 To st.PieceCount)

    End If


    With st.Pieces(st.PieceCount)

        .Part = partName
        .L = pieceL
        .W = pieceW

    End With

End Sub


' =========================================================
' ОЧИСТКА РАСКЛАДКИ
' =========================================================

Private Sub ClearLayout( _
    ByVal ws As Worksheet, _
    ByVal topLeft As Range)


    Dim r As Long
    Dim c As Long

    r = topLeft.Row
    c = topLeft.Column


    With ws.Range( _
        ws.Cells(r, c), _
        ws.Cells(r + 500, c + 15))

        .ClearContents

        .Font.Bold = False
        .Interior.ColorIndex = xlNone
        .Borders.LineStyle = xlNone

    End With

End Sub


' =========================================================
' ВЫВОД РАСКЛАДКИ
' =========================================================

Private Sub DumpLayoutDetailed( _
    ByVal ws As Worksheet, _
    ByRef plates() As tPlate, _
    ByVal plateCount As Long, _
    ByVal topLeft As Range)


    Dim r As Long
    Dim c As Long

    r = topLeft.Row
    c = topLeft.Column


    ClearLayout ws, topLeft


    ws.Cells(r, c).Value = _
        "РАСКЛАДКА (детали по полосам)"

    ws.Cells(r, c).Font.Bold = True


    ws.Cells(r + 1, c + 0).Value = "Плита"
    ws.Cells(r + 1, c + 1).Value = "Полоса"
    ws.Cells(r + 1, c + 2).Value = "Ширина полосы, мм"
    ws.Cells(r + 1, c + 3).Value = "Деталь"
    ws.Cells(r + 1, c + 4).Value = "Кусок (ДxШ), мм"
    ws.Cells(r + 1, c + 5).Value = "Длина куска, мм"
    ws.Cells(r + 1, c + 6).Value = "Накоплено в полосе, мм"
    ws.Cells(r + 1, c + 7).Value = "Свободно по длине, мм"
    ws.Cells(r + 1, c + 8).Value = "Свободно по ширине плиты, мм"
    ws.Cells(r + 1, c + 9).Value = "Использовано по ширине, мм"


    With ws.Range( _
        ws.Cells(r + 1, c), _
        ws.Cells(r + 1, c + 9))

        .Font.Bold = True
        .Interior.Color = RGB(200, 200, 200)

    End With


    Dim outRow As Long

    outRow = r + 2


    Dim i As Long
    Dim s As Long
    Dim p As Long


    For i = 1 To plateCount

        Dim usedW As Long

        usedW = _
            plates(i).W - plates(i).RemainingW


        For s = 1 To plates(i).StripCount

            Dim cumL As Long

            cumL = 0


            For p = 1 To plates(i).Strips(s).PieceCount

                cumL = cumL + _
                    plates(i).Strips(s).Pieces(p).L


                ws.Cells(outRow, c + 0).Value = _
                    plates(i).PlateLabel

                ws.Cells(outRow, c + 1).Value = s

                ws.Cells(outRow, c + 2).Value = _
                    plates(i).Strips(s).W

                ws.Cells(outRow, c + 3).Value = _
                    plates(i).Strips(s).Pieces(p).Part


                Dim displayW As Long

                displayW = _
                    plates(i).Strips(s).Pieces(p).W


                ws.Cells(outRow, c + 4).Value = _
                    plates(i).Strips(s).Pieces(p).L & _
                    " x " & displayW

                ws.Cells(outRow, c + 5).Value = _
                    plates(i).Strips(s).Pieces(p).L

                ws.Cells(outRow, c + 6).Value = _
                    cumL

                ws.Cells(outRow, c + 7).Value = _
                    plates(i).L - cumL

                ws.Cells(outRow, c + 8).Value = _
                    plates(i).RemainingW

                ws.Cells(outRow, c + 9).Value = _
                    usedW


                ApplyColorFormattingV3 _
                    ws, _
                    outRow, _
                    c, _
                    plates(i).Strips(s).Pieces(p).Part


                outRow = outRow + 1

            Next p


            ws.Cells(outRow, c + 3).Value = _
                "ИТОГО по полосе"

            ws.Cells(outRow, c + 3).Font.Bold = True


            ws.Cells(outRow, c + 6).Value = _
                plates(i).Strips(s).UsedL

            ws.Cells(outRow, c + 7).Value = _
                plates(i).L - _
                plates(i).Strips(s).UsedL


            ws.Range( _
                ws.Cells(outRow, c), _
                ws.Cells(outRow, c + 9)).Interior.Color = _
                RGB(240, 240, 240)


            outRow = outRow + 1

        Next s


        outRow = outRow + 1

    Next i


    ws.Columns(c).Resize(, 10).AutoFit


    Dim lastRow As Long

    lastRow = outRow - 1


    If lastRow > r + 1 Then

        With ws.Range( _
            ws.Cells(r + 1, c), _
            ws.Cells(lastRow, c + 9))

            .Borders.LineStyle = xlContinuous
            .Borders.Weight = xlThin

        End With

    End If

End Sub


' =========================================================
' ЦВЕТА
' =========================================================

Private Sub ApplyColorFormattingV3( _
    ByVal ws As Worksheet, _
    ByVal rowNum As Long, _
    ByVal startCol As Long, _
    ByVal partName As String)


    Dim cellRange As Range

    Set cellRange = ws.Range( _
        ws.Cells(rowNum, startCol), _
        ws.Cells(rowNum, startCol + 9))


    cellRange.Interior.ColorIndex = xlNone


    If InStr(1, partName, _
        "Столешница 1", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(173, 216, 230)


    ElseIf InStr(1, partName, _
        "Столешница 2", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(135, 206, 250)


    ElseIf InStr(1, partName, _
        "Столешница 3", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(100, 180, 240)


    ElseIf InStr(1, partName, _
        "Стеновая панель 1", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(255, 218, 185)


    ElseIf InStr(1, partName, _
        "Стеновая панель 2", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(255, 200, 150)


    ElseIf InStr(1, partName, _
        "Стеновая панель 3", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(255, 182, 130)


    ElseIf InStr(1, partName, _
        "Стеновая панель 4", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(255, 165, 100)


    ElseIf InStr(1, partName, _
        "Стеновая панель 5", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(255, 140, 70)


    ElseIf InStr(1, partName, _
        "Боковая панель 1", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(220, 220, 220)


    ElseIf InStr(1, partName, _
        "Боковая панель 2", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(200, 200, 200)


    ElseIf InStr(1, partName, _
        "Боковая панель 3", vbTextCompare) > 0 Then

        cellRange.Interior.Color = _
            RGB(180, 180, 180)


    ' Сначала подклейка, затем обычный торец
    ElseIf InStr(1, partName, _
        "Подклейка торца", vbTextCompare) > 0 Then


        If InStr(1, partName, _
            "Подклейка торца 1", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(230, 220, 250)


        ElseIf InStr(1, partName, _
            "Подклейка торца 2", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(210, 200, 240)


        ElseIf InStr(1, partName, _
            "Подклейка торца 3", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(190, 180, 230)


        ElseIf InStr(1, partName, _
            "Подклейка торца 4", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(170, 160, 220)


        ElseIf InStr(1, partName, _
            "Подклейка торца 5", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(150, 140, 210)


        ElseIf InStr(1, partName, _
            "Подклейка торца 6", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(130, 120, 200)


        ElseIf InStr(1, partName, _
            "Подклейка торца 7", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(110, 100, 190)


        ElseIf InStr(1, partName, _
            "Подклейка торца 8", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(90, 80, 180)


        Else

            cellRange.Interior.Color = _
                RGB(200, 190, 235)

        End If


    ElseIf InStr(1, partName, _
        "Торец", vbTextCompare) > 0 Then


        If InStr(1, partName, _
            "Торец 1", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(220, 245, 220)


        ElseIf InStr(1, partName, _
            "Торец 2", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(200, 235, 200)


        ElseIf InStr(1, partName, _
            "Торец 3", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(180, 225, 180)


        ElseIf InStr(1, partName, _
            "Торец 4", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(160, 215, 160)


        ElseIf InStr(1, partName, _
            "Торец 5", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(140, 205, 140)


        ElseIf InStr(1, partName, _
            "Торец 6", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(120, 195, 120)


        ElseIf InStr(1, partName, _
            "Торец 7", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(100, 185, 100)


        ElseIf InStr(1, partName, _
            "Торец 8", vbTextCompare) > 0 Then

            cellRange.Interior.Color = _
                RGB(80, 175, 80)


        Else

            cellRange.Interior.Color = _
                RGB(200, 240, 200)

        End If


    Else

        cellRange.Interior.Color = _
            RGB(255, 255, 255)

    End If

End Sub


' =========================================================
' ХЕЛПЕРЫ
' =========================================================

Private Function IsTrueCell( _
    ByVal v As Variant) As Boolean


    On Error GoTo SafeFalse


    If VarType(v) = vbBoolean Then

        IsTrueCell = CBool(v)
        Exit Function

    End If


    If IsNumeric(v) Then

        IsTrueCell = (CLng(v) <> 0)
        Exit Function

    End If


    Dim s As String

    s = UCase$(Trim$(CStr(v)))


    IsTrueCell = _
        (s = "TRUE" Or _
         s = "ИСТИНА" Or _
         s = "ДА" Or _
         s = "YES")

    Exit Function


SafeFalse:

    IsTrueCell = False

End Function


Private Function ReadMm( _
    ByVal ws As Worksheet, _
    ByVal addr As String) As Long


    Dim v As Variant

    v = ws.Range(addr).Value


    If Not IsNumeric(v) Then

        Err.Raise _
            1001, , _
            "Не число в ячейке " & addr

    End If


    ReadMm = CLng( _
        Application.WorksheetFunction.Round(v, 0))

End Function


Private Function ReadMmOptional( _
    ByVal ws As Worksheet, _
    ByVal addr As String) As Long


    Dim v As Variant

    v = ws.Range(addr).Value


    If IsEmpty(v) Or _
       Trim$(CStr(v)) = "" Then

        ReadMmOptional = 0
        Exit Function

    End If


    Dim d As Double

    d = ParseMmToDouble(v)


    If Abs(d) < 0.0000001 Then

        ReadMmOptional = 0

    Else

        ReadMmOptional = _
            CLng(Application.WorksheetFunction.Round(d, 0))

    End If

End Function


Private Function ParseMmToDouble( _
    ByVal v As Variant) As Double


    On Error GoTo Fail


    If IsNumeric(v) Then

        ParseMmToDouble = CDbl(v)
        Exit Function

    End If


    Dim s As String
    Dim i As Long
    Dim ch As String
    Dim buf As String


    s = Replace(CStr(v), ",", ".")

    buf = ""


    For i = 1 To Len(s)

        ch = Mid$(s, i, 1)

        If (ch >= "0" And ch <= "9") Or _
           ch = "." Or _
           ch = "-" Then

            buf = buf & ch

        End If

    Next i


    If buf = "" Or _
       buf = "-" Or _
       buf = "." Then

        ParseMmToDouble = 0#

    Else

        ParseMmToDouble = CDbl(buf)

    End If


    Exit Function


Fail:

    ParseMmToDouble = 0#

End Function


Private Function MinPositive4( _
    ByVal a As Long, _
    ByVal b As Long, _
    ByVal c As Long, _
    ByVal d As Long) As Long


    Dim m As Long

    m = 0


    If a > 0 Then
        m = a
    End If


    If b > 0 Then

        If m = 0 Or b < m Then
            m = b
        End If

    End If


    If c > 0 Then

        If m = 0 Or c < m Then
            m = c
        End If

    End If


    If d > 0 Then

        If m = 0 Or d < m Then
            m = d
        End If

    End If


    MinPositive4 = m

End Function


' =========================================================
' ДОБАВЛЕНИЕ ДЕТАЛЕЙ С РАЗБИЕНИЕМ
' =========================================================

Private Sub AppendPiecesNamedSplitWH( _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByRef n As Long, _
    ByVal itemL As Long, _
    ByVal itemW As Long, _
    ByVal maxL As Long, _
    ByVal maxW As Long, _
    ByVal partName As String)


    If itemL <= 0 Or itemW <= 0 Then
        Exit Sub
    End If


    If maxL <= 0 Or maxW <= 0 Then

        Err.Raise _
            1201, , _
            "Неверные ограничения раскроя maxL/maxW."

    End If


    ' =====================================================
    ' РАЗБИЕНИЕ ПО ШИРИНЕ
    ' =====================================================

    Dim fullW As Long
    Dim remW As Long
    Dim wParts As Long
    Dim wIdx As Long


    fullW = itemW \ maxW
    remW = itemW Mod maxW


    If remW > 0 Then
        wParts = fullW + 1
    Else
        wParts = fullW
    End If


    If wParts = 0 Then Exit Sub


    ' =====================================================
    ' РАЗБИЕНИЕ ПО ДЛИНЕ
    ' =====================================================

    Dim fullL As Long
    Dim remL As Long
    Dim lParts As Long
    Dim lIdx As Long


    fullL = itemL \ maxL
    remL = itemL Mod maxL


    If remL > 0 Then
        lParts = fullL + 1
    Else
        lParts = fullL
    End If


    If lParts = 0 Then Exit Sub


    ' =====================================================
    ' СОЗДАНИЕ КУСКОВ
    ' =====================================================

    For wIdx = 1 To wParts


        Dim curW As Long


        If wIdx <= fullW Then

            curW = maxW

        Else

            curW = remW

        End If


        Dim baseName As String

        baseName = partName


        If wParts > 1 Then

            baseName = _
                baseName & _
                " (полоса " & _
                wIdx & "/" & wParts & ")"

        End If


        For lIdx = 1 To fullL

            n = n + 1

            EnsureArrays _
                lens, wids, names, n


            lens(n) = maxL
            wids(n) = curW


            If lParts > 1 Then

                names(n) = _
                    baseName & _
                    " (кусок " & _
                    lIdx & "/" & lParts & ")"

            Else

                names(n) = baseName

            End If

        Next lIdx


        If remL > 0 Then

            n = n + 1

            EnsureArrays _
                lens, wids, names, n


            lens(n) = remL
            wids(n) = curW


            If lParts > 1 Then

                names(n) = _
                    baseName & _
                    " (кусок " & _
                    lParts & "/" & lParts & ")"

            Else

                names(n) = baseName

            End If

        End If

    Next wIdx

End Sub


Private Sub EnsureArrays( _
    ByRef lens() As Long, _
    ByRef wids() As Long, _
    ByRef names() As String, _
    ByVal n As Long)


    If n = 1 Then

        ReDim lens(1 To 1)
        ReDim wids(1 To 1)
        ReDim names(1 To 1)

    Else

        ReDim Preserve lens(1 To n)
        ReDim Preserve wids(1 To n)
        ReDim Preserve names(1 To n)

    End If

End Sub


' =========================================================
' ОЧИСТКА РАЗМЕРОВ
' =========================================================

Public Sub ClearStollSizesV3()

    ThisWorkbook.Sheets("Расчет П-образный").Range( _
        "N29:N38,N21:N28,O20:AE20,AF29:AF38,AA39:AE39,O39:S39").ClearContents

    MsgBox _
        "Размеры столешницы очищены", _
        vbInformation

End Sub


Public Sub ClearTorezSizesV3()

    ThisWorkbook.Sheets("Расчет П-образный").Range( _
        "O30:O32,T21:W21,AE30:AE32,AC38,AA32:AA34,W28,S32:S34,Q38").ClearContents

    MsgBox _
        "Размеры торцов столешницы очищены", _
        vbInformation

End Sub


Public Sub ClearPanelSizesV3()

    ThisWorkbook.Sheets("Расчет П-образный").Range( _
        "G21:G37,H38,O13:AE13,N14:N15,AN21:AN37,AM38,AG44:AG47,AA48:AF48,O48:S48,N44:N47").ClearContents

    MsgBox _
        "Размеры стеновых панелей очищены", _
        vbInformation

End Sub


Public Sub ClearSidePanelsV3()

    ThisWorkbook.Sheets("Расчет П-образный").Range( _
        "C21:C37,D38:E38,N8:N10,O7:AE7,AS21:AS37,AQ38:AR38").ClearContents

    MsgBox _
        "Размеры боковых панелей очищены", _
        vbInformation

End Sub


Public Sub ClearPanelsPodkleykaV3()

    ThisWorkbook.Sheets("Расчет П-образный").Range( _
        "J21:J37,K38,N18,O17:AE17,AI39,AJ21:AJ38,AF41,AA42:AE42,X32:X37,Y38,V32:V37,U38,O42:S42,N41,T31:Z31,Z30").ClearContents

    MsgBox _
        "Размеры подклейки торца очищены", _
        vbInformation

End Sub


' =========================================================
' СОХРАНЕНИЕ В АРХИВ
' =========================================================

Public Sub SaveToArchiveSimpleV3()

    Dim wsArchive As Worksheet
    Dim wsCalc As Worksheet

    Dim lastRow As Long


    Set wsCalc = _
        ThisWorkbook.Sheets("Расчет П-образный")


    On Error Resume Next

    Set wsArchive = _
        ThisWorkbook.Sheets("Архив")

    On Error GoTo 0


    If wsArchive Is Nothing Then

        MsgBox _
            "Лист 'Архив' не найден. Создайте лист с именем 'Архив'.", _
            vbExclamation

        Exit Sub

    End If


    If IsEmpty(wsCalc.Range("AX21").Value) Then

        MsgBox _
            "Ячейка AX21 пустая. Сначала выполните расчет.", _
            vbExclamation

        Exit Sub

    End If


    lastRow = _
        wsArchive.Cells( _
            wsArchive.Rows.Count, "A").End(xlUp).Row + 1


    If lastRow = 2 And _
       wsArchive.Cells(1, 1).Value = "" Then


        wsArchive.Cells(1, 1).Value = _
            "Дата архивации"

        wsArchive.Cells(1, 2).Value = _
            "Время архивации"

        wsArchive.Cells(1, 3).Value = _
            "Тип расчета"

        wsArchive.Cells(1, 4).Value = _
            "Стоимость"


        With wsArchive.Range("A1:D1")

            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .Interior.Color = RGB(220, 220, 220)

        End With


        lastRow = 2

    End If


    With wsArchive

        .Cells(lastRow, 1).Value = Date
        .Cells(lastRow, 1).NumberFormat = "dd.mm.yyyy"

        .Cells(lastRow, 2).Value = Time
        .Cells(lastRow, 2).NumberFormat = "hh:mm:ss"

        .Cells(lastRow, 3).Value = _
            "Расчет П-образной столешницы"

        .Cells(lastRow, 4).Value = _
            wsCalc.Range("AX21").Value

        .Cells(lastRow, 4).NumberFormat = _
            "#,##0.00"

    End With


    wsArchive.Columns("A:D").AutoFit


    MsgBox _
        "Данные сохранены в архив!", _
        vbInformation

End Sub