Danke im Voraus für eure Hilfe.
Gruß Peter
Set rngC = Range("Q5", "Q" & lar)
For Each rngC In rngC
If rngC "" Or rngC 0 Then
IntC = IntC + 1
End If
Next
Columns("Q:Q").Select
If IntC = 0 Then
Selection.Columns.Group
ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
End If