Sub UpdateDeliveryAndPayment()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Лист1")
        Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim i As Long
    For i = 2 To lastRow
        ' Наименование
        Dim name As String
        name = ws.Cells(i, 2).Value
        
        ' Сумма аванса
        Dim advanceAmount As Double
        advanceAmount = 0
        For j = 4 To 15
            If ws.Cells(i, j).Value <> "" Then
                advanceAmount = ws.Cells(i, j).Value
                Exit For
            End If
        Next j
        
        ' Срок поставки
        Dim deliveryTerm As Integer
        deliveryTerm = ws.Cells(i, 16).Value
        
        ' Рассчитываем месяц поставки
        Dim deliveryMonth As Integer
        For j = 4 To 15
            If ws.Cells(i, j).Value = advanceAmount Then
                deliveryMonth = j + deliveryTerm
                If deliveryMonth > 15 Then
                    deliveryMonth = deliveryMonth - 12
                End If
                Exit For
            End If
        Next j
        
        ' Обновление поставки
        ws.Cells(i, deliveryMonth + 3).Value = advanceAmount
        
        ' Рассчитываем месяц оплаты остатка
        Dim paymentMonth As Integer
        paymentMonth = deliveryMonth + 1
        If paymentMonth > 15 Then
            paymentMonth = paymentMonth - 12
        End If
        
        ' Обновление оплаты остатка
        ' Предположим, что оплата остатка равна авансу (на самом деле это должно быть разница между авансом и поставкой)
        ws.Cells(i, paymentMonth + 3 + 12).Value = advanceAmount
    Next i
End Sub