Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
136to140
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
136to140
136to140
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchen/Markieren/Verschieben

Suchen/Markieren/Verschieben
17.07.2002 11:30:48
Patrizia
Hallo !!!

Ich hoffe mir kann jemand bei meinem folgenden Problem helfen:

Ich möchte in einer Tabelle nach einem bestimmten Wert suchen.
Wenn dieser Wert gefunden wird die komplette Zeile in der der Wert enthalten ist ausschneiden und in eine ander Tabelle verschieben.

Mein Code:

Sub ArtikelSuchenKopieren()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt

Static Suchbegriff As String
Dim Zelle, ErsteAdresse, ArbeitsblattDaten, ArbeitsblattErgebnis As String
Dim LetzteZelle, intCount As Integer
Application.ScreenUpdating = False

ArbeitsblattDaten = "00 - 19 VDS 00-19" 'Tabelle, in der gesucht wird
ArbeitsblattErgebnis = "test" 'Tabelle, in der die Ergebnisse stehen

Sheets(ArbeitsblattErgebnis).Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub

Sheets(ArbeitsblattDaten).Activate
Rows(1).Copy 'Überschriftenzeile kopieren ...
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
ActiveSheet.Paste '... und in dem anderen Tabellenblatt einfügen

Sheets(ArbeitsblattDaten).Activate
With ActiveSheet.UsedRange
Set Zelle = .Find(Suchbegriff, LookIn:=xlValues)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
LetzteZelle = Sheets(ArbeitsblattErgebnis).Cells(Cells.Rows.Count, 1).End(xlUp).Row
Rows(Zelle.Row).Copy

Sheets(ArbeitsblattErgebnis).Select
Cells(LetzteZelle + 1, 1).Select
ActiveSheet.Paste
Sheets(ArbeitsblattDaten).Activate
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ErsteAdresse
End If

Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
End With

Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True

End Sub

Habe diesen Code hier im Board gefunden und für meine Zwecke abgewandelt.

Habe jetzt folgendes Problem mit meinem Code:
1. Er kopiert nur die gefunden Zeilen aus der 1. Tabelle in die
2. Tabelle und schneidet diese nicht aus. Wenn möglich sollte
die Zeile ausgeschnitten werden die leere Zeile gelöscht und
ins 2. Tabellenblatt eingetragen werden.
2. Wenn die gefunden Zeilen nun im 2. Tabellenblatt eingefügt
werden werden immer die alten Einträge überschrieben. Dies
soll ab nicht so sein. Sollte in der 2. Tabelle bereits was
eingefügt sein sollen die gefunden Zeilen unten drunter ange-
fügt werden und nicht die bestehenden überschreiben.

Wäre ganz toll wenn mir jemand helfen könnte.
Für eure Hilfe bedanke ich mich bereits im voraus.

Patrizia


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

Betreff
Datum
Anwender
Anzeige
Re: Suchen/Markieren/Verschieben
17.07.2002 12:51:49
Udo
Hallo Patrizia,
1.nach
Rows(Zelle.Row).Copy
Rows(Zelle.Row).EntireRow.Delete

2.nach
ActiveSheet.Paste
LetzteZelle=LetzteZelle+1

Dann sollte es klappen

Gruss Udo

Re: Suchen/Markieren/Verschieben
17.07.2002 13:09:23
Patrizia
Hallo Udo,

danke erstmal für deine Hilfe.
Leider funktioniert es nicht bei mir.
Bringt mir einen Fehler.
Wo genau in meinem Code muß ich deine zeilen einfügen ???

Patrizia

Re: Suchen/Markieren/Verschieben
18.07.2002 12:56:14
Udo
Hallo Patrizia,
1.hinter der Zeile
Rows(Zelle.Row).Copy
die Zeile
Rows(Zelle.Row).EntireRow.Delete
einfügen
2.hinter die Zeile
ActiveSheet.Paste
die Zeile
LetzteZelle=LetzteZelle+1
einfügen.
Dann sollte es klappen.

Gruss Udo

Anzeige
Re: Suchen/Markieren/Verschieben
18.07.2002 13:51:42
Patrizia
Hallo Udo,

habe meinen Code jetzt folgendermaßen geändert:Sub ArtikelSuchenKopieren()
'Sucht einen Begriff in einem bestimmten Blatt,
'und kopiert die Ergebnisse in ein anderes Blatt

Static Suchbegriff As String
Dim Zelle, ErsteAdresse, ArbeitsblattDaten, ArbeitsblattErgebnis As String
Dim LetzteZelle, intCount As Integer
Application.ScreenUpdating = False

ArbeitsblattDaten = "00 - 19 VDS 00-19" 'Tabelle, in der gesucht wird
ArbeitsblattErgebnis = "test" 'Tabelle, in der die Ergebnisse stehen

Sheets(ArbeitsblattErgebnis).Cells.Clear 'Alte Tabelleninhalte löschen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", Default:=Suchbegriff)
If Suchbegriff = "" Then Exit Sub

Sheets(ArbeitsblattDaten).Activate
Rows(Zelle.Row).Copy 'Überschriftenzeile kopieren ...
Rows(Zelle.Row).EntireRow.Delete
Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
ActiveSheet.Paste '... und in dem anderen Tabellenblatt einfügen
LetzteZelle = LetzteZelle + 1

Sheets(ArbeitsblattDaten).Activate
With ActiveSheet.UsedRange
Set Zelle = .Find(Suchbegriff, LookIn:=xlValues)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
Do
LetzteZelle = Sheets(ArbeitsblattErgebnis).Cells(Cells.Rows.Count, 1).End(xlUp).Row
Rows(Zelle.Row).Copy

Sheets(ArbeitsblattErgebnis).Select
Cells(LetzteZelle + 1, 1).Select
ActiveSheet.Paste
Sheets(ArbeitsblattDaten).Activate
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> ErsteAdresse
End If

Sheets(ArbeitsblattErgebnis).Select
Range("a1").Select
End With

Application.CutCopyMode = xlCopy
Application.ScreenUpdating = True

End Sub


Funktioniert aber leider nicht bringt mir immer eine Fehlermeldung - erst Objekt erforderlich und markiert die Zeile
die ich neu eingefügt habe (deine Zeile zu 1.) und dann schreibt er noch Paste-Methode .... nicht möglich.

So ein Sch......
Bin am verzweifeln.
Ich hoffe du kannst mir noch helfen wäre dir sehr dankbar
dafür.

Patrizia

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige