Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spalten nach Text durchsuchen

Spalten nach Text durchsuchen
19.01.2009 12:47:13
Kall
Hallo zusammen,
ich brächte mal eure Hilfe, in der such habe ich nichts passendes gefunden. Ich nöchte die Spalte A ab Reihe 16 bis zum Ende nach einem Begriff "UA" durchsuchen (den es öfter geben kann), und wenn ich diese gefunden habe die komplette Zeile in die Tabelle 5 kopieren, über VBA.
Kann mir jemand bitte helfen wie ich das machen kann ?
Danke für Eure Hilfe
Gruß Kall

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalten nach Text durchsuchen
19.01.2009 13:48:00
fcs
Hallo Kall,
hier mein Vorschlag.
Die Namen der Quell- und Zieltabelle muss du ggf. noch anpassen.
Gruß
Franz

Sub Suchen_UA()
Call Suchen_Kopieren(wksQuelle:=Worksheets("Tabelle1"), wksZiel:=Worksheets("Tabelle5"), _
varSuchen:="UA", Spalte:=1, ZeileStart:=16)
End Sub
Sub Suchen_Kopieren(wksQuelle As Worksheet, wksZiel As Worksheet, varSuchen, _
Optional Spalte As Long = 1, Optional ZeileStart As Long = 1)
'Durchsucht eine Spalte der Quelltabelle nach dem Suchbegriff und _
kopiert gefundene Zeilen in die Zieltabelle. Gesucht wird nach Übereinstimmumg _
des gesamten Zellwertes
'wksQuelle  = Tabellenblatt in dem gesucht werden soll
'wksZiel    = Tabelle in die die gefundenen Zeilen kopiert werden sollen
'varSuchen  = Suchbegriff
'Spalte     = Nr. der zu durchsuchenden Spalte
'ZeileStart = Nr. der Zeile ab der gesucht werden soll
Dim rngZelle As Range, ZeileZiel As Long, strZelle1 As String, rngBereich As Range
Dim ZeileLetzte As Long
'letzte Datenzeile in Zieltabelle Spalte A
With wksZiel
ZeileZiel = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wksQuelle
'letzte Datenzeile in Suchspalte der Quelltabelle
ZeileLetzte = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If ZeileLetzte >= ZeileStart Then
'Suchbereich setzen
Set rngBereich = .Range(.Cells(16, Spalte), .Cells(ZeileLetzte, 16))
'Suchbegriff suchen
Set rngZelle = rngBereich.Find(What:=varSuchen, LookIn:=xlValues, _
lookat:=xlWhole)
If rngZelle Is Nothing Then
MsgBox "Suchbegriff """ & varSuchen & """ nicht gefunden!"
Else
'1. Fundstelle merken
strZelle1 = rngZelle.Address
Do
ZeileZiel = ZeileZiel + 1
rngZelle.EntireRow.Copy Destination:=wksZiel.Cells(ZeileZiel, 1)
'nächste Fundstelle suchen
Set rngZelle = rngBereich.FindNext(After:=rngZelle)
Loop Until rngZelle.Address = strZelle1
wksZiel.Activate
MsgBox "Fertig mit Suchen und Kopieren"
End If
Else
MsgBox "Keine Daten im Suchbereich der Quell-Tabelle"
End If
End With
End Sub


Anzeige
AW: Spalten nach Text durchsuchen
19.01.2009 13:56:19
Kall
Hallo,
vielen Dank, ich glaube das ist es, habe es schon mal kurz getestet und werde es noch anpassen.
Ich verneige mich und danke dir:-)
Gruß Kall
AW: Spalten nach Text durchsuchen
19.01.2009 14:12:00
gerwas
Hallo Koll
so sollte es auch gehen:

Sub suche_ua()
Set quelle = ThisWorkbook.Sheets("Tabelle1")
Set ziel = ThisWorkbook.Sheets("Tabelle5")
For k = 16 To quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row
If UCase(quelle.Cells(k, 1)) = "UA" Then
quelle.Rows(k).Copy
ziel.Cells(ziel.Cells(quelle.Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial  _
Paste:=xlValues
End If
Next
Set quelle = Nothing
Set ziel = Nothing
End Sub


Gruß gerwas

Anzeige

336 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige