---

Sub Razdelenie_LIC_ALAE()

    ' Переменные
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim newRow As Long
    Dim amount As Double

    ' Ускоряем работу Excel
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    ' Исходный лист
    Set ws = ThisWorkbook.Worksheets("LIC ALAE")

    ' Создаём новый лист
    Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
    newWs.Name = "LIC ALAE результат"

    ' Определяем последнюю строку
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Определяем последний используемый столбец
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' Копируем заголовки
    ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Copy _
        Destination:=newWs.Cells(1, 1)

    ' Первая строка для данных
    newRow = 2

    ' Перебираем исходные строки
    For i = 2 To lastRow

        ' Если в F стоит "прочее"
        If LCase(Trim(ws.Cells(i, "F").Value)) = "прочее" _
           And IsNumeric(ws.Cells(i, "D").Value) _
           And ws.Cells(i, "D").Value <> "" Then

            ' Запоминаем исходную сумму
            amount = ws.Cells(i, "D").Value

            ' Первая строка — ОСАГО Физ, 87%
            ws.Range(ws.Cells(i, 1), ws.Cells(i, lastCol)).Copy _
                Destination:=newWs.Cells(newRow, 1)

            newWs.Cells(newRow, "A").Value = "ОСАГО Физ"
            newWs.Cells(newRow, "D").Value = amount * 0.87

            newRow = newRow + 1

            ' Вторая строка — ОСАГО Юр, 13%
            ws.Range(ws.Cells(i, 1), ws.Cells(i, lastCol)).Copy _
                Destination:=newWs.Cells(newRow, 1)

            newWs.Cells(newRow, "A").Value = "ОСАГО Юр"
            newWs.Cells(newRow, "D").Value = amount * 0.13

            newRow = newRow + 1

        Else

            ' Судебные и неустойка копируем как есть
            ws.Range(ws.Cells(i, 1), ws.Cells(i, lastCol)).Copy _
                Destination:=newWs.Cells(newRow, 1)

            newRow = newRow + 1

        End If

    Next i

    ' Автоматическая ширина столбцов
    newWs.Columns.AutoFit

    ' Возвращаем настройки Excel
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "Готово! Создан лист: LIC ALAE результат"

End Sub