Hallo,
der folgende Code sucht bestimmte Begriffe aus Tabelle 1 und kopiert die gefunden Ergebnisse in Tabbelle 2. Ersteinmal Danke Franz.
Änderung:
Wie kann man den Code so ändern, daß die Suchbegriffe nicht mehr abgefragt werden sonder zB. von N3 bis N20 Begriffe stehen und diese dann in Tabelle2 aufgelistet werden. Erst N3 dann 5 Zeilen nach rechts und N4 und so weiter. Falls einer der Zellen N2 bis N20 leer ist wird sie übergangen.
Danke für jede Hilfe.
MFG
Xen55
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
Archiv:
http://www.wer-weiss-was.de/cgi-bin/forum/showarchiv…