hilfe...
tim
der untenstehende code durchsucht zwei geschlossene dateien (test1 + test2) und fügt die ganze zeile aller fundstellen im activen workbook (test3)(sheet 'suchen') ein. so muss es bleiben, denn das wars was ich brauchte.
nun möchte ich den code aber so anpassen, dass mit dem selben suchbegriff (varSuchbegriff) auch das active workbook (test3) durchsucht wird und ebenso alle zeilen der fundstellen ins sheet (suchen) kopiert werden.
kann mir da jemand eine schlefe einbauen?
vielen dank
tim
Sub suchen()
Dim intIndex As Integer, intZeile1 As Integer, intZeile2 As Integer
Dim strDateiname As String
Dim varSuchbegriff As Variant
Dim myRange As Range
Dim myWorksheet As Worksheet
varSuchbegriff = Application.InputBox("Bitte den Suchbegriff eingeben.", "Eingabe")
If varSuchbegriff = False Or Trim(varSuchbegriff) = "" Then Exit Sub
Set myWorksheet = ThisWorkbook.Worksheets("suchen")
myWorksheet.Cells.ClearContents
Application.ScreenUpdating = False
For intIndex = 1 To 2
strDateiname = "test" & Choose(intIndex, "1", "2") & ".xls"
GetObject "D:\" & strDateiname
With Workbooks(strDateiname).Worksheets(Choose(intIndex, "artikel", "beschreibung"))
On Error Resume Next
.ShowAllData
On Error GoTo 0
For intZeile1 = 2 To 500
Set myRange = .Range(.Cells(intZeile1, 1), .Cells(intZeile1, 13)).Find(What:=varSuchbegriff, LookIn:=xlValues, LookAt:=xlPart)
If Not myRange Is Nothing Then
intZeile2 = intZeile2 + 1
myWorksheet.Range(myWorksheet.Cells(intZeile2, 1), myWorksheet.Cells(intZeile2, 13)) = .Range(.Cells(myRange.Row, 1), .Cells(myRange.Row, 13)).Value
End If
Next
End With
Workbooks(strDateiname).Close SaveChanges:=False
Next
Set myRange = Nothing
Set myWorksheet = Nothing
Application.ScreenUpdating = True
End Sub
Anzeige