Begriff suchen und Fundzeilen in anderes Blatt kopieren

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

Gruppe

Allgemein

Bereich

Suchen

Thema

Begriff suchen und Fundzeilen in anderes Blatt kopieren

Problem

Ein über InputBox abzufragender Name ist zu suchen und die Fundzeilen sind in ein zweites Blatt zu übertragen.

Lösung

Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.




StandardModule: Modul1

Sub SearchNames()
   Dim rng As Range, rngSource As Range, rngStart As Range
   Dim varInput As Variant
   Dim iRow As Integer
   varInput = Application.InputBox( _
      prompt:="Geben Sie bitte den Namen ein:", _
      Title:="Namen-Zeilen kopieren", _
      Default:="Name 4", _
      Left:=263, _
      Top:=169, _
      Type:=2)
   If varInput = False Then Exit Sub
   Set rng = ActiveSheet.Columns("A:F").Find( _
      what:=varInput, lookat:=xlWhole, LookIn:=xlValues)
   If rng Is Nothing Then
      Beep
      MsgBox "Suchbegriff nicht gefunden!"
      Exit Sub
   End If
   Set rngStart = rng
   Set rngSource = rng.EntireRow
   Do
      Set rng = Cells.FindNext(After:=rng)
      If rng.Address = rngStart.Address Then Exit Do
      Set rngSource = Application.Union(rngSource, rng.EntireRow)
   Loop
   With Worksheets("Target")
      iRow = .Cells(Rows.Count, 1).End(xlUp).Row
      If iRow = 1 Then iRow = 2 Else iRow = iRow + 3
      rngSource.Copy .Cells(iRow, 1)
      .Columns.AutoFit
   End With
End Sub