Sub Itog()
    Dim sh As Worksheet, sh0 As Worksheet
    Application.ScreenUpdating = 0
    Set sh0 = ActiveSheet
    With sh0
        .Copy after:=Sheets(.Index)
    End With
    Set sh = ActiveSheet
    With sh
        .Name = "Итог_" & Format(Now, "YYYY_MM_DD hh_mm_ss")
        nc_ = 4
        For i = 1 To 2
            c_ = 1 + (i - 1) * 4
            r1_ = .Cells(.Rows.Count, c_).End(3).Row
'            sh0.Cells(2, c_ + 1).Resize(r1_, nc_ - 2).ClearContents
            For j = r1_ To 1 Step -1
                If .Cells(j, c_ + 2) = "" And .Cells(j, c_) <> "" Then
                    If .Cells(j, c_).MergeCells Then
                        If .Cells(j + 2, c_ + 2) = "" Then
                            .Cells(j, c_).Offset(-1).Resize(3, nc_).Delete Shift:=xlUp
                        End If
                    Else
                        .Cells(j, c_).Resize(1, nc_).Delete Shift:=xlUp
                    End If
                End If
            Next j
        Next i
        .DrawingObjects.Delete
        For i = 2 To 1 Step -1
            c_ = 3 + (i - 1) * 4
            If .Cells(4, c_) = "" Then
                .Cells(1, c_ - 2).Resize(, 4).EntireColumn.Delete
                nd_ = nd_ + 1
            End If
        Next i
        If nd_ = 2 Then
            Application.DisplayAlerts = 0
            .Delete
            Application.DisplayAlerts = 1
            MsgBox "Вы ничего не выбрали"
            sh0.Select
        End If
    End With
    Application.ScreenUpdating = 1
End Sub

Sub Udal()
    Application.ScreenUpdating = 0
    nc_ = 4
    For i = 1 To 2
        c_ = 3 + (i - 1) * 4
        r1_ = Cells(Rows.Count, c_).End(3).Row
        Cells(2, c_).Resize(r1_).ClearContents
    Next i
    Application.ScreenUpdating = 1
End Sub