Option Explicit
Sub Beispiel_z2_q1()
Dim rngData As Excel.Range
With Worksheets("q1")
Set rngData = MyFilterFunc("aa", .Columns("B"))
If Not rngData Is Nothing Then
Set rngData = Intersect(rngData.EntireRow, .Range("A:A, B:B, D:D"))
rngData.Copy Worksheets("z2").Range("A1")
End If
End With
End Sub
Public Function MyFilterFunc( _
SearchFor As String, _
SearchIn As Excel.Range, _
Optional SearchOrder As XlSearchOrder = xlByColumns _
) As Excel.Range
Dim rngData As Excel.Range
Dim rngResult As Excel.Range
Dim strFirstAddr As String
Set rngResult = SearchIn.Find(SearchFor, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=SearchOrder, MatchByte:=False)
strFirstAddr = rngResult.Address
Do
If Not rngData Is Nothing Then
Set rngData = Union(rngData, rngResult)
Else
Set rngData = rngResult
End If
Set rngResult = SearchIn.FindNext(rngResult)
Loop While rngResult.Address <> strFirstAddr
Set MyFilterFunc = rngData
End Function