Sub DeleteEmptyColumns()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim ColumnIndex As Integer
    Dim RowIndex As Integer
    Dim IsColumnEmpty As Boolean
    
    ' Setze das aktive Arbeitsblatt
    Set ws = ActiveSheet
    
    ' Ermittle die letzte Spalte und die letzte Zeile
    LastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' Gehe von der letzten Spalte rückwärts durch alle Spalten
    For ColumnIndex = LastColumn To 1 Step -1
        IsColumnEmpty = True ' Gehe davon aus, dass die Spalte leer ist, bis das Gegenteil bewiesen wird
        ' Überprüfe jede Zelle in der Spalte (außer der Überschrift)
        For RowIndex = 2 To LastRow
            If Trim(ws.Cells(RowIndex, ColumnIndex).Value) <> "" Then
                IsColumnEmpty = False
                Exit For
            End If
        Next RowIndex
        
        ' Wenn die gesamte Spalte (außer der Überschrift) leer ist, lösche sie
        If IsColumnEmpty Then
            ws.Columns(ColumnIndex).EntireColumn.Delete
        End If
    Next ColumnIndex
End Sub