Hallo,
Habe eine Liste die aus mehreren Spalten besteht. Eine Zeile gehört zusammen.
Wie kann ich diese Liste nach einen bestimmten Wert durchsuchen und wenn dieser in der Liste vorkommt, diese Zeile in eine andere Tabelle kopieren???
Das alles in VBA.
Danke für jede Hilfe.
MFG
Xen55
Hallo Xen55,
folgendes Makro tut’s. Gesucht wird immer nach dem vollständigen Zellinhalt.
Bei Suche nach Texten muss du die kommentierte Zeile löschen oder zu Kommentar machen. Die Fehler-Eoutine kannst du dann auch löschen.
Gruß
Franz
Sub SuchenKopieren()
'Sucht Begriff in Spalte A der Quelle und kopiert Zeile in Zeiletabelle
Dim wksQuelle As Worksheet, wksZiel As Worksheet, Suchen As Variant, Finden As Range
Set wksQuelle = ActiveWorkbook.Worksheets("Tab1")
Set wksZiel = ActiveWorkbook.Worksheets("Tab2")
Zeile = 2 'Zeile in Zieltabelle an der kopierte Zeile eingefügt werden soll
Suchen = InputBox("Gesuchter Wert?", "Suchen und Kopieren")
If Suchen = "" Then Exit Sub 'Abbrechen geklickt
On Error GoTo Fehler
Suchen = CDbl(Suchen) 'Diese Zeile und unten die Fehlermeldung löschen wenn Texte gesucht werden sollen
Set Finden = wksQuelle.Columns(1).Find(What:=Suchen, LookIn:=xlValues, Lookat:=xlWhole, Searchorder:=xlByColumns)
If Finden Is Nothing Then
MsgBox "Wert nicht gefunden"
Else
wksQuelle.Rows(Finden.Row).Copy
wksZiel.Paste Destination:=wksZiel.Cells(Zeile, 1) 'Zielzeile wird überschrieben
' wksZiel.Cells(Zeile, 1).Insert Shift:=xlShiftDown 'kopierte Zeile wird eingefügt
Application.CutCopyMode = False
End If
wksZiel.Select
Exit Sub
Fehler:
MsgBox ("Suchbegriff ist keine Zahl")
End Sub
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
dazu Frage
Hallo Franz,
Danke erst mal, hat alles soweit geklappt!!
Wollte dich noch fragen, wie man den den Code so hinkriegt, das er die ganze Liste durchsucht und alle gefundenen Suchergebnisse in Tabelle 2 kopiert (immer die nächste freie Zelle), also nicht nur ein Treffer.
Danke
MFG
Xen55
Hallo Xen,
mit folgenden Anpassungen werden alle Fundstellen in der Spalte kopiert.
Gruß
Franz
Sub SuchenKopieren()
'Sucht Begriff in Spalte A der Quelle und kopiert Zeile in Zieltabelle
Dim wksQuelle As Worksheet, wksZiel As Worksheet, Suchen As Variant, Finden As Range
Dim Addresse1 As String
Set wksQuelle = ActiveWorkbook.Worksheets("Tab1")
Set wksZiel = ActiveWorkbook.Worksheets("Tab2")
Zeile = 2 'Zeile in Zieltabelle an der kopierte Zeile eingefügt werden soll
Suchen = InputBox("Gesuchter Wert?", "Suchen und Kopieren")
If Suchen = "" Then Exit Sub 'Abbrechen geklickt
On Error GoTo Fehler
Suchen = CDbl(Suchen) 'Diese Zeile und unten die Fehlermeldung löschen wenn Texte gesucht werden sollen
Set Finden = wksQuelle.Columns(1).Find(What:=Suchen, LookIn:=xlValues, Lookat:=xlWhole, Searchorder:=xlByColumns)
If Finden Is Nothing Then
MsgBox "Wert nicht gefunden"
Else
Adresse1 = Finden.Address
Do
wksQuelle.Rows(Finden.Row).Copy
wksZiel.Paste Destination:=wksZiel.Cells(Zeile, 1) 'Zielzeile wird überschrieben
' wksZiel.Cells(Zeile, 1).Insert Shift:=xlShiftDown 'kopierte Zeile wird eingefügt
Set Finden = wksQuelle.Columns(1).FindNext(After:=Finden)
Zeile = Zeile + 1
Loop Until Finden.Address = Adresse1 Or Finden Is Nothing
Application.CutCopyMode = False
End If
wksZiel.Select
Exit Sub
Fehler:
MsgBox ("Suchbegriff ist keine Zahl")
End Sub
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]