Sub Zeilen_Ohne_Hyperlink_Loeschen()
Dim hl As Hyperlink, rngHL As Range, rngDel As Range, c As Range
For Each hl In ActiveSheet.Hyperlinks
If rngHL Is Nothing Then
Set rngHL = hl.Range.EntireRow
Else
Set rngHL = Union(rngHL, hl.Range.EntireRow)
End If
Next
If Not rngHL Is Nothing Then
For Each c In ActiveSheet.UsedRange.Columns(1).Cells
If Application.Intersect(c, rngHL) Is Nothing Then
If rngDel Is Nothing Then
Set rngDel = c.EntireRow
Else
Set rngDel = Union(rngDel, c.EntireRow)
End If
End If
Next
rngDel.EntireRow.Delete
End If
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen