bestimmte Zelleninhalte kopieren

Hallo,
ich habe in meiner Excel Tabelle auf dem ersten Blatt nur eine einzige Spalte mit ca. 500 Einträgen. Aus dieser Spalte möchte ich weitere Blätter erstellen, die jeweils nur die Zellen zeigen, in denen bestimmte Wörter enthalten sind. Die Zelleneinträge folgen keinem Format, aber bestimmte Wörter kommen immer wieder vor, gleich geschrieben. Für manche Blätter reicht es mir nur die Zellen zu kopieren, in denen ein Wort vorkommt (z.B. Amnesty), für andere Blätter würde ich gerne nach mehreren Wörtern suchen und eben alle Zellen kopieren, in denen diese mehreren Wörter vorkommen (z.B. alle Zellen mit EU und alle Zellen mit UN). Ich habe eine Beispielmappe angehängt mit den ersten 100 Einträgen.
Gibt es dafür eine einfache Möglichkeit die ohne VBA auskommt?
Über jegliche Anregung würde ich mich freuen,
Danke
https://www.herber.de/bbs/user/142171.xlsx

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Nee eigentlich hatte ich gehofft, jemand könnte helfen. Habe jetzt versucht mich selber einzufrickeln und dieses Makro anderswo gefunden und angepasst.

Sub CopyAmnesty()
' CopyAmnesty Makro
Dim Loletzte As Long
Dim RngZ As Range
For Each RngZ In Worksheets("Tabelle1").Range("A1:A100")
Loletzte = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row + 1
If RngZ Like "*Amnesty*" Then Worksheets("Tabelle3").Cells(Loletzte, 1) = RngZ
Next
End Sub

Das funktioniert soweit gut. Was mir jetzt noch fehlt wäre eine Option nicht nur nach dem einen Wort, hier Amnesty, sondern gleichzeitig nach mehreren zu suchen. Habe schon ein paar Varianten ausprobiert mit OR oder mit , dazwischen. Mag er aber alles nicht. Wenn mir da jemand helfen könnte. Glaskugel habe ich ja nun schon selber erfolgreich durchleuchtet ;)
Danke, Christian

Sub CopyAmnesty() Dim Loletzte As Long, RngZ As Range, iCount% For Each RngZ In Worksheets("Tabelle2").Range("A1:A100") iCount = iCount + 1 Loletzte = Worksheets("UN Documents").Cells(Rows.Count, 1).End(xlUp).Row + 1 If RngZ Like "*Amnesty*" Or RngZ Like "*Mokha*" Then _ Worksheets("UN Documents").Cells(Loletzte, 1) = RngZ Next End Sub

Sub CopyAmnesty() Dim iRowIn%, RngZ As Range For Each RngZ In Worksheets("Tabelle2").Range("A1:A100") If RngZ Like "*Amnesty*" Or RngZ Like "*Mokha*" Then Worksheets("UN Documents").Cells(iRowIn, 1) = RngZ iRowIn = Worksheets("UN Documents").Cells(Rows.Count, 1).End(xlUp).Row + 1 End If Next End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

bestimmte Zelleninhalte kopieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread