|
Hallo,
versuchs mal hiermit:
Option Explicit
Public Sub test()
Dim objCell As Range, objUnion As Range
Dim avntArray() As Variant
Dim strFirstAddress As String
Dim lngIndex As Long
avntArray = Array("A", "B", "C", "D") '// Suchbegriff-Array auf Deine 15 erweitern.....
With ThisWorkbook
For lngIndex = 1 To .Worksheets.Count
With .Worksheets(lngIndex).Columns(2)
Set objCell = .Find(What:=avntArray(lngIndex - 1), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not objCell Is Nothing Then
strFirstAddress = objCell.Address
Do
If objUnion Is Nothing Then
Set objUnion = objCell.EntireRow
Else
Set objUnion = Union(objUnion, objCell.EntireRow)
End If
Set objCell = .FindNext(After:=objCell)
Loop Until objCell.Address = strFirstAddress
Call objUnion.Delete
Set objCell = Nothing
Set objUnion = Nothing
End If
End With
Next
End With
End Sub
Gruß,
|