VBA Suchfunktion, Ergebnis kopieren

Hallo liebe Pros!
Da ich im Makroschreiben mehr als "grün hinter den Ohren" bin, habe ich vor einigen Tagen jemanden gebeten, mir anhand einer Beispielsdatei eine Suchfunktion als Makro zu schreiben.
Diesen Makrovorschlag (der im Original funktionierte) habe ich heute in meine aktuelle Datei übertragen. Zum Teil mussten im VBA einige Infos angepasst werden, was ich bereits getan habe, soweit ich es konnte. Allerdings funktioniert das Makro nach wie vor noch nicht einwandfrei.
Deswegen hoffe ich, dass vielleicht jemand von Euch den Code so korrigieren kann, dass es wie gewünscht funktioniert.
Hier

Die Datei https://www.herber.de/bbs/user/73503.xls wurde aus Datenschutzgründen gelöscht

oder hier
http://www.file-upload.net/download-3207005/Tabellephvhoff.xls.html
findet Ihr meine Datei.
Das Makro, um das es geht, ist das Modul 3 im VBA. In der Menüleiste ist es die Schaltfläche "Analysis".
Was soll das Makro in einer perfekten Welt tun:
Per Knopfdruck (Makroschaltfläche) wird das Makro gestartet und ein Dialogfenster erscheint, in das ich einen beliebigen Suchbegriff eingeben kann. - Soweit läuft das Makro schon
Wenn ich als Suchbegriff z.B. "Physical Resistance" eingebe, soll im Arbeitsblatt "Items" nach allen Zellen gesucht werden, die exakt diesen Begriff enthalten.
Anschließend sollen alle Zeilen, die in einer beliebigen Zelle den Suchbegriff beinhalten, vollständig in das Arbeitsblatt "Analyze" übertragen werden, allerdings so, dass dabei nicht
die Zeile 1, die bereits Überschriften enthält, überschrieben wird.
Fall dies für die Lösung wichtig sein wollte:
1. Die Suchkriterien, die ich später eingeben werde, befinden sich im Arbeitsblatt "Items" ausschließlich in den Spalten L,N,P,R,T,V, AH und AJ.
2. Es kann durchaus sein, dass noch weitere Items in das Arbeitsblatt "Items" eingetragen werden. Soll heißen: bei Zeile 282 muss in Zukunft nicht zwingend schon Schluss sein.
Wie immer gespannt und mit herzlichem Dank!
Philipp

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Philipp,
teste mal.

Sub transfer()
  Dim rng As Range, rngFound As Range
  Dim strFirst As String, strSearch As String
  Dim lngRows() As Long, lngCount As Long


  strSearch = Application.InputBox("Suchbegriff:", "Suche", Type:=2)

  If strSearch = CStr(False) Or strSearch = "" Then Exit Sub

  Redim lngRows(0)

  With Sheets("Analyze")
    .Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count)).Clear
  End With

  With Sheets("Items")
    Set rng = .UsedRange.Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole, _
      MatchCase:=False, searchFormat:=False, After:=.Cells(1, 1))
    If Not rng Is Nothing Then
      strFirst = rng.Address
      Do
        If IsError(Application.Match(rng.Row, lngRows, 0)) Then
          Redim Preserve lngRows(lngCount)
          lngRows(lngCount) = rng.Row
          lngCount = lngCount + 1
          If rngFound Is Nothing Then
            Set rngFound = rng.EntireRow
          Else
            Set rngFound = Union(rngFound, rng.EntireRow)
          End If
        End If
        Set rng = .UsedRange.FindNext(rng)
      Loop While Not rng Is Nothing And strFirst <> rng.Address
    End If
  End With

  If Not rngFound Is Nothing Then
    rngFound.Copy Sheets("Analyze").Range("A2")
  End If

  Set rngFound = Nothing
  Set rng = Nothing
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

VBA Suchfunktion, Ergebnis kopieren

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Suchfunktion, Ergebnis kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread