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

Suchen, Auswählen und Ausgeben mehrerer Zellen

Forumthread: Suchen, Auswählen und Ausgeben mehrerer Zellen

Suchen, Auswählen und Ausgeben mehrerer Zellen
28.02.2006 09:32:46
Stephan
Guten Morgen!
Aufgrund mangelnder Kenntnisse würde ich gerne wissen wie ich folgendes Problem mittels VBA-Programmierung lösen kann:
Ich möchte zum aus einer Tabelle alle Zellen die das Wort "Schaft" (z.B. in der Spalte A) zusammen mit den zugehörigen Werten (z.B. in der Spalte B) aus dem Tabellenblatt eins in ein eigenes Tabellenblatt kopieren.
Wie kann mich solch ein Problem mit einem selbst erstellten Makro lösen?
Vielen Dank für die Auskunft,
Stephan
Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen, Auswählen und Ausgeben mehrerer Zellen
28.02.2006 13:22:54
Heiko
Hallo Stephan,
z.B. so:

Sub ZusammenKopieren()
Dim strSuchtext As String, strQuellTabelle As String, strZielTabelle As String
Dim lngI As Long, lngN As Long
' Namen der Quelltabelle anpassen
strQuellTabelle = "Tabelle1"
strSuchtext = InputBox("Bitte geben Sie den Suchtext ein !", " Suchtext", "Shaft")
If strSuchtext = "" Or strSuchtext = "False" Or strSuchtext = "Falsch" Then
Exit Sub
End If
Sheets.Add After:=Worksheets(Worksheets.Count)
On Error Resume Next
' Wenn schon eine Tabelle mit dem Namen Gesammelte_Daten vorhanden ist dann bleibt der von
' EXCEL vergebene Name z.B. Tabelle12 halt erhalten.
ActiveSheet.Name = "Gesammelte_Daten"
On Error GoTo 0
strZielTabelle = ActiveSheet.Name
lngN = 1
With Worksheets(strQuellTabelle)
For lngI = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If InStr(.Cells(lngI, 1), strSuchtext) > 0 Then
.Cells(lngI, 1).EntireRow.Copy Destination:=Worksheets(strZielTabelle).Rows(lngN)
lngN = lngN + 1
End If
Next lngI
End With
End Sub

Gruß Heiko
PS: Rückmeldung wäre nett !
Anzeige

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige