AW: mehrere xls durchsuchen?!
Veit
Moin, Moin,
vielleicht hilft Dir das ja weiter:
Sub Makro4()
Dim treffer As String
Dim Pfad As String
Dim suchmappe As Workbook
Dim zielmappe As Workbook
Dim suchliste As Worksheet
Set suchmappe = ThisWorkbook
Set suchliste = suchmappe.Worksheets("Suchbegriffe")
Pfad = "C:\test\"
Dateiname = Dir$(Pfad)
If Dateiname = "" Then
MsgBox "nix vorhanden"
Exit Sub
End If
Do While Dateiname <> ""
Workbooks.Open Filename:=Pfad & Dateiname
Set zielmappe = Workbooks(Dateiname)
spalte = 2
For i = 1 To zielmappe.Worksheets.Count
If zielmappe.Sheets(i).Name <> "Suchbegriffe" Then
test = zielmappe.Worksheets(i).Cells(2, 2).Value
With zielmappe.Worksheets(i).Range("a1:f200")
For suchzähler = 1 To 300
suche = suchliste.Cells(suchzähler, 1).Value
If suche = "" Then Exit For
Set c = .Find(suche, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
treffer = c.Address
suchliste.Cells(suchzähler, spalte).Value = treffer 'Hyperlink
suchliste.Activate
suchliste.Hyperlinks.Add Anchor:=Range(Cells(suchzähler, spalte), Cells(suchzähler, spalte)), Address:=Pfad & Dateiname, TextToDisplay:=treffer
spalte = spalte + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
c = ""
spalte = 2
End If
Next suchzähler
End With
End If
Next i
Windows(Dateiname).Close
Dateiname = Dir$()
Loop
End Sub
Gruß
Ein Veit