Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
736to740
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
736to740
736to740
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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

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

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige