Sub LoescheLeereOderNullSpalten()
    Dim LastCol As Long
    Dim CurrentCol As Long
    Dim rng As Range
    Dim cell As Range
    Dim IsZeroOrEmpty As Boolean
    Dim ws As Worksheet
    Dim MaxRow As Long

    ' Setzen Sie das aktive Arbeitsblatt
    Set ws = ThisWorkbook.ActiveSheet

    ' Ermitteln Sie die letzte Spalte mit Daten
    LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' Ermitteln Sie die maximale Zeilennummer für das gesamte Arbeitsblatt
    For CurrentCol = 1 To LastCol
        Dim tempLastRow As Long
        tempLastRow = ws.Cells(ws.Rows.Count, CurrentCol).End(xlUp).Row
        If tempLastRow > MaxRow Then MaxRow = tempLastRow
    Next CurrentCol

    ' Loop rückwärts durch die Spalten
    For CurrentCol = LastCol To 1 Step -1
        
        ' Setzen Sie den Bereich für die gesamte Spalte von der ersten bis zur maximalen Zeile
        Set rng = ws.Range(ws.Cells(2, CurrentCol), ws.Cells(MaxRow, CurrentCol))
        
        IsZeroOrEmpty = True ' Standardmäßig annehmen, dass die Spalte nur 0 oder leer ist
        
        ' Loop durch jede Zelle im Bereich
        For Each cell In rng
            If Not IsError(cell.Value) Then
                If cell.Value <> "" And cell.Value <> 0 Then
                    IsZeroOrEmpty = False
                    Exit For
                End If
            Else
                IsZeroOrEmpty = False
                Exit For
            End If
        Next cell

        ' Wenn die gesamte Spalte leer oder 0 ist, löschen Sie die Spalte
        If IsZeroOrEmpty Then
            ws.Columns(CurrentCol).Delete
        End If
    Next CurrentCol
End Sub