leere Spalten ein- ausblenden

Private bolVerstecken As Boolean

Public Sub LeereSpaltenEinAus()
Dim intSp As Integer, intAnt As Integer
Dim sha As Shape

On Error GoTo Fehler

  'prüfen ob Tabelle Daten enthält
  If Cells.Find("*", , , , xlByRows, xlPrevious) Is Nothing Then
    MsgBox "Tabelle enthält keine Daten!", vbInformation, "Abbruch"
    End
  End If

  bolVerstecken = Not bolVerstecken

  Application.ScreenUpdating = False
    For Each sha In ActiveSheet.Shapes
      sha.Visible = msoTrue
    Next sha

    'Warnung wenn Zeichnungsobjekte vorhanden:
    If ActiveSheet.Shapes.Count > 0 And bolVerstecken = True Then
      intAnt = MsgBox("Diese Tabelle enthält " & _
            ActiveSheet.Shapes.Count & " Zeichnungsobjekte." _
            & vbNewLine & vbNewLine & _
            "Dies kann zu Problemen führen." _
            & vbNewLine & _
            "Trotzdem weiter?", vbYesNoCancel, "Warnung:")
      If intAnt <> vbYes Then
        bolVerstecken = Not bolVerstecken
        Exit Sub
      End If

    End If

    For intSp = 1 To Columns.Count
      If WorksheetFunction.CountA(Columns(intSp)) = 0 Then
        Columns(intSp).Hidden = bolVerstecken
      End If
    Next intSp

  Application.ScreenUpdating = False
Exit Sub

Fehler:
  Application.ScreenUpdating = True
  MsgBox "FehlerNr.: " & Err.Number & vbNewLine & _
         "Beschreibung: " & Err.Description, _
         vbCritical, "Fehler in: LeereSpaltenEinAus"
End Sub