Private Sub Command1_Click()
Dim wsDaten As Object
Dim wsSuchErg As Object
Dim wbDaten As Object
Dim wbSuchErg As Object
Dim exob As Object
 
    suchwort = Text1.Text
 
    Set exob = CreateObject("excel.application")
    Set wbDaten = exob.Workbooks.Open("d:\mappe1.xls") 'Pfad & Dateiname von 
    ' der Datei, wo die Daten drinstehen
    Set wbSuchErg = exob.Workbooks.Open("d:\mappe2.xls") 'Pfad & Dateiname von 
    ' der Datei, wo die Suchworte reinkommen
    Set wsDaten = wbDaten.Worksheets("Daten") 'Name der Tabelle (Worksheet) der 
    ' Daten-Datei
    Set wsSuchErg = wbSuchErg.Worksheets("Suchergebnisse") 'Name der Tabelle 
    ' der Suchergebnis-Datei
 
    reihe = 1
    wsSuchErg.Rows("1:3000").ClearContents '3000 ggf. durch die maximale Anzahl 
    ' der Datensätze ersetzen
 
    For i = 1 To 3000 '3000 ggf. durch die maximale Anzahl der Datensätze 
    ' ersetzen
        If wsDaten.Cells(i, 1) = "" Then
            'nächster Datensatz
        Else
            For j = 1 To 12
                If wsDaten.Cells(i, j) = suchwort Or InStr(1, wsDaten.Cells(i, _
                  j), suchwort, vbTextCompare) > 0 Then
                    For x = 1 To 12
                        wsSuchErg.Cells(reihe, x) = wsDaten.Cells(i, x)
                    Next x
                    reihe = reihe + 1
                    Exit For
                End If
            Next j
        End If
    Next i
    wbSuchErg.Save
    wbSuchErg.Close
    wbDaten.Close False
    exob.Quit
    MsgBox "Suche ist beendet"
End Sub