Sub HideEmptyCellInRanges()
    Dim i           As Long
    Dim RowRange As Range, cell As Range
    Dim checkedRows As Object
    Dim rangeAddress As String
    Application.ScreenUpdating = False

    If TypeName(Selection) = "Range" Then
        Set checkedRows = CreateObject("Scripting.Dictionary")

        For Each cell In Selection
            i = cell.Row
            rangeAddress = "D" & i & ":H" & i & ",J" & i & ":J" & i & ",L" & i & ":L" & i & ",N" & i & ":P" & i & _
                    ",R" & i & ":R" & i & ",T" & i & ":V" & i & ",X" & i & ":Y" & i & ",AA" & i & ":AA" & i

            If Not checkedRows.exists(i) Then
                checkedRows.Add i, True
                Set RowRange = ActiveSheet.Range(rangeAddress)

                If Application.WorksheetFunction.CountA(RowRange) = 0 Then

                    ActiveSheet.Rows(i).EntireRow.Hidden = True
                End If

            End If

        Next cell

    End If

    Set RowRange = Nothing
    Set checkedRows = Nothing
    Application.ScreenUpdating = True
End Sub

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