|
Hallo,
ok dann kombinieren wir meinen 1. und 2. Code, die Suchbegriffe werden im Array avntArray angepasst, probiers mal hiermit:
Option Explicit
Public Sub test3()
Dim avntArray() As Variant
Dim lngIndex As Long
avntArray = Array("A", "B", "C", "D", "E") '// Hier Dein Suchbegriff-Array anpassen oder erweitern.....
Application.DisplayAlerts = False
With ThisWorkbook
For lngIndex = 1 To .Worksheets.Count
With .Worksheets(lngIndex)
If .ListObjects.Count = 1 Then
With .ListObjects(1).Range
Call .AutoFilter(Field:=2, Criteria1:= _
"<>" & avntArray(lngIndex - 1), Operator:=xlAnd)
With .SpecialCells(Type:=xlCellTypeVisible)
If .Areas(1).Rows.Count = 1 And .Areas(1).Rows(1).Row = 1 Then
If .Areas.Count = 2 Then Call .Areas(2).Delete
ElseIf .Areas.Count = 1 Then
With .Areas(1)
Call .Range(.Rows(2), .Rows(.Rows.Count)).Delete
End With
Else
With .Areas(1)
Call .Range(.Rows(2), .Rows(.Rows.Count)).Delete
End With
Call .Areas(2).Delete
End If
End With
Call .AutoFilter(Field:=2)
End With
End If
End With
Next
End With
Application.DisplayAlerts = True
End Sub
Gruß,
|