Sub Раздел()
   
Set y = Cells.Find(What:="Расход счет", LookIn:=xlValues, LookAt:=xlWhole)
Set x = Application.InputBox("Укажите ячейку, под которой добавить раздел", "Запрос для раздела", "", Type:=8)
Set Z = Cells.Find(What:="Приход счет", LookIn:=xlValues, LookAt:=xlWhole)
sname = InputBox("Укажите имя раздела", "")
Range(Cells(x.Row + 1, 1), Cells(x.Row + 5, 1)).EntireRow.Select
Selection.Insert Shift:=xlDown
Range(Cells(x.Row + 1, 1), Cells(x.Row + 4, 1)).EntireRow.RowHeight = 18
Range(Cells(x.Row + 1, 1), Cells(x.Row + 4, 1)).EntireRow.Interior.Color = 16777215
Cells(x.Row + 1, 1).Value = sname
Range(Cells(x.Row + 2, 1), Cells(x.Row + 4, 1)).HorizontalAlignment = xlLeft
Range(Cells(x.Row + 2, 1), Cells(x.Row + 4, 1)).Value = "Новая статья"
    If y.Row > x.Row Then
    
    Rows(Z.Row + 2).Select
    Selection.Copy
    Rows(x.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Rows(Z.Row + 3).Select
    Selection.Copy
    Range(Rows(x.Row + 2), Rows(x.Row + 4)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
    Range(Cells(Z.Row + 2, 2), Cells(Z.Row + 6, 3)).Select
    Selection.Copy
    Range(Cells(x.Row + 1, 2), Cells(x.Row + 5, 3)).Select
    ActiveSheet.Paste
        
    Else
         Rows(y.Row + 2).Select
    Selection.Copy
    Rows(x.Row + 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Rows(y.Row + 3).Select
    Selection.Copy
    Range(Rows(x.Row + 2), Rows(x.Row + 4)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    
   Range(Cells(y.Row + 2, 2), Cells(y.Row + 6, 3)).Select
    Selection.Copy
    Range(Cells(x.Row + 1, 2), Cells(x.Row + 5, 3)).Select
    ActiveSheet.Paste
    End If
Range(Cells(x.Row + 2, 1), Cells(x.Row + 5, 1)).EntireRow.Select
Selection.Group
  
    
End Sub

Sub Статья()

SName = InputBox("Укажите имя статьи", "Имя столбца", "")
If ActiveCell.Row < 9 Then
        MsgBox "Укажите крайнюю статью необходимого подраздела"
    Else
    With ActiveCell.EntireRow
            .Insert
            .Copy .Rows(0)
            .ClearContents
            .FormulaR1C1 = SName
        End With
    End If
End Sub