Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Not IsNumeric(Target.Value) Or Target.Value = "" Then
            Exit Sub
        End If
    Else
        Exit Sub
    End If
    Application.EnableEvents = False
    If Target.Column = 2 Then
        Cells(Target.Row, Target.Column + 2) = Cells(Target.Row, Target.Column) + Cells(Target.Row, Target.Column + 1)
    Else
        If Target.Column = 3 Then
            Cells(Target.Row, Target.Column + 1) = Cells(Target.Row, Target.Column - 1) + Cells(Target.Row, Target.Column)
        Else
            If Target.Column = 4 Then
                Cells(Target.Row, Target.Column - 2) = Cells(Target.Row, Target.Column) - Cells(Target.Row, Target.Column - 1)
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Sub temp()
    Application.DisplayAlerts = False
    For i = 6 To Cells(Rows.Count, 2).End(xlUp).Row
    Range("F" & i).FormulaR1C1 = "=MID(RC[-3],1,LEN(RC[-3])-4)"
    Path = Cells(i, 6).Value
    MkDir Path
    Path = Path & "\photo"
    MkDir Path
        FileCopy Cells(i, 3).Value, Path & "\" & Cells(i, 2).Value
    Next
    Application.DisplayAlerts = True
End Sub

=ИНДЕКС($B$2:$B$25;ПОИСКПОЗ(G2;$A$2:$A$25;0)+СЧЁТЕСЛИ(G$1:$G2;G2)-1)

Option Explicit
Sub CopyIf()
    With ActiveWorkbook.Sheets("Приходы")
        Dim lrow, i, j As Long
        lrow = .Cells(Rows.Count, 7).End(xlUp).Row
        j = 2
        For i = 2 To lrow
            If .Range("G" & i) = "Терминал" Or .Range("G" & i) = "Расрочка\кредит" Then
                .Range("G" & i).EntireRow.Copy ActiveWorkbook.Sheets("Расход").Range("A" & j)
                j = j + 1
            End If
        Next i
    End With
End Sub

Option Explicit
Sub AddAdvertising()
    Const MAX_ADV As Integer = 3
    Dim i As Long, rnd As Integer
    With ActiveWorkbook.Sheets("Лист1")
        rnd = MAX_ADV
        For i = .Cells(Rows.Count, 1).End(xlUp).Row + 2 To 10 Step -1
            If i Mod 15 = 2 Then
                .Rows(i).Insert Shift:=xlDown
                .Rows(i).Insert Shift:=xlDown
                .Rows(i).Insert Shift:=xlDown
                .Range("A" & i) = "#EXTINF:0,audio-" & rnd & ".mp3"
                .Range("A" & i + 1) = "audio-" & rnd & ".mp3"
                If rnd = 1 Then
                    rnd = MAX_ADV
                Else
                    rnd = rnd - 1
                End If
            End If
        Next i
        
    End With
End Sub

Sub Макрос1()
Dim i As Long, lr As Long, x As Long, x2 As Long, n As Long, k As Long
Dim flag As Boolean
flag = True
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
    lvl = Rows(i).OutlineLevel
    If lvl = 3 Then
        colmn = 4
        For n = i + 1 To lr
            lvl2 = Rows(n).OutlineLevel
            If flag And Rows(n + 1).OutlineLevel <> 4 Then
                Rows(n + 1).Insert Shift:=xlDown
                flag = False
            Else
                flag = False
            End If
            If lvl2 = 4 Then
                Cells(i, colmn) = Cells(n, 1)
                Cells(i + 1, colmn) = Cells(n, 2)
                Cells(i + 2, colmn) = Cells(n, 3)
                colmn = colmn + 1
            Else
                i = n - 1
                Exit For
            End If
        Next n
    End If
    flag = True
Next i
End Sub