gibt es für diesen Code (Schleife) eine schnellere Alternative. Der Datenbestand der durchsucht werden soll ist riesig.
Sub LG_suchen()
Dim rngAct As Range
Dim strFindFirst As String
Dim intLoopCount As Integer
Dim varFind As Variant
Dim i As Long
i = 1
'Begrenzung des zu durchsuchenden Bereichs
With Worksheets("Tabelle1").Columns(6)
'1. Übereinstimmung finden
Set varFind = .Find(What:="Aktuell", After:=Range("F1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
If Not varFind Is Nothing Then
'1. Zelle für das Beenden der Do-Loop-Schleife merken
strFindFirst = varFind.Address
Do
'Treffer hochzählen
intLoopCount = intLoopCount + 1
'Zelle mit Suchkriterium in Tabelle2 kopieren
Range(varFind.Address).EntireRow.Copy Destination:=Worksheets("Tabelle2"). _
Cells(i, 1)
i = i + 1
'nächste Zelle suchen
Set varFind = .FindNext(varFind)
'Schleife ausführen, solange das Suchkriterium gefunden
'wird und bis letztendlich wieder die 1. Zelle erreicht ist
'(sonst würde es in einer Endlosschleife enden)
Loop While Not varFind Is Nothing And varFind.Address strFindFirst
End If
End With
MsgBox intLoopCount
End Sub
Danke für die Hilfe.
Gruß Werner