Sub AnjasHausaufgabe()
Dim wbQuelle As Workbook
Dim sFilename As String
Dim lFile As Long
Dim sSuchbegriff As Variant
Dim rSuchrange As Range
Dim rFund As Range
Dim wsZiel As Worksheet
Dim lZielZeile As Long
Set wsZiel = Workbooks.Add().Worksheets(1)
lZielZeile = 1
For lFile = 1 To 6
sFilename = "c:\anja\" & lFile & ".xlsx"
Set wbQuelle = Workbooks.Open(sFilename, ReadOnly:=True)
Set rSuchrange = wbQuelle.Worksheets(1).Range("A1:C12")
For Each sSuchbegriff In Array("Äpfel", "Bananen", "Mandarinen", "Apfelsinen")
Set rFund = rSuchrange.Cells.Find(sSuchbegriff, , xlValues, xlWhole)
If Not rFund Is Nothing Then
wsZiel.Cells(lZielZeile, 1).Value = rFund.Offset(0, 1).Value
lZielZeile = lZielZeile + 1
End If
Set rFund = Nothing
Next sSuchbegriff
wbQuelle.Close
Next lFile
wsZiel.Parent.SaveAs "c:\anja\Test2", FileFormat:=51
End Sub