Sub Удалить_бесполезный_столбец()
 Dim j As Long
 
 j = ActiveCell.Column
 Columns(j -  1 ).ColumnWidth = Columns(j -  1 ).ColumnWidth + Columns(j).ColumnWidth
 Columns(j).Delete Shift:=xlToLeft
    Range("AB4").Select
End Sub

Option Explicit

Sub Удалить_бесполезный_столбец()
 Dim r1 As Long
 Dim r2 As Long
 Dim c1 As Long
 Dim c2 As Long
 Dim i As Long
 Dim j As Long
 Dim udalit_stolbec As Boolean
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 With ActiveSheet.UsedRange
   r1 = .Rows( 1 ).Row
   r2 = r1 + .Rows.Count -  1 
   c1 = .Columns( 1 ).Column
   c2 = c1 + .Columns.Count -  1 
 End With
 
 
 For j = c1 +  1  To c2
  udalit_stolbec = True
  
  For i = r1 To r2
   With Cells(i, j)
     If .Formula <> "" Or _
      .Borders(xlEdgeLeft).LineStyle <> xlNone Or _
      .Borders(xlEdgeRight).LineStyle <> xlNone Or _
      .Borders(xlEdgeTop).LineStyle <> .Offset( 0 , - 1 ).Borders(xlEdgeTop).LineStyle Or _
      .Borders(xlEdgeBottom).LineStyle <> .Offset( 0 , - 1 ).Borders(xlEdgeBottom).LineStyle Then
      udalit_stolbec = False
      Exit For

     End If
   End With
  Next i
  
  If udalit_stolbec Then
   Columns(j -  1 ).ColumnWidth = Columns(j -  1 ).ColumnWidth + Columns(j).ColumnWidth +  0 . 288 
   Columns(j).Delete Shift:=xlToLeft
   
   If j >= c2 Then Exit For

   c2 = c2 -  1 
   j = j -  1 

  End If
 Next j
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 MsgBox "Готово, большинство лишних столбцов удалены", vbInformation
 
End Sub

Sub Удалить_бесполезные_столбцов()
 Dim r1 As Long
 Dim r2 As Long
 Dim c1 As Long
 Dim c2 As Long
 Dim i As Long
 Dim j As Long
 Dim ch As Range
 Dim udalit_stolbec As Boolean
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 

 For Each ch In ActiveSheet.UsedRange
  
  If ch.MergeCells = True And ch.Address = ch.MergeArea.Cells( 1 ,  1 ).Address Then
   With ch.MergeArea
     .Borders(xlInsideVertical).LineStyle = xlNone
   End With
  End If
 Next ch
 
 
 With ActiveSheet.UsedRange
   r1 = .Rows( 1 ).Row
   r2 = r1 + .Rows.Count -  1 
   c1 = .Columns( 1 ).Column
   c2 = c1 + .Columns.Count -  1 
 End With
 
 
 For j = c1 +  1  To c2
  udalit_stolbec = True
  
  For i = r1 To r2
   With Cells(i, j)
     If .Formula <> "" Or _
      .Borders(xlEdgeLeft).LineStyle <> xlNone Or _
      .Borders(xlEdgeRight).LineStyle <> xlNone Or _
      .Borders(xlEdgeTop).LineStyle <> .Offset( 0 , - 1 ).Borders(xlEdgeTop).LineStyle Or _
      .Borders(xlEdgeBottom).LineStyle <> .Offset( 0 , - 1 ).Borders(xlEdgeBottom).LineStyle Then
      udalit_stolbec = False
      Exit For

     End If
   End With
  Next i
  
  If udalit_stolbec Then
   Columns(j -  1 ).ColumnWidth = Columns(j -  1 ).ColumnWidth + Columns(j).ColumnWidth +  0 . 288 
   Columns(j).Delete Shift:=xlToLeft
   If j >= c2 Then Exit For
   c2 = c2 -  1 
   j = j -  1 

  End If
 Next j
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 MsgBox "Готово, лишние столбцы удалены", vbInformation
 
End Sub