Frage von kikichog, 29

Wie kann ich E-Mail Adressen durch Makros rausfiltern?

Hallo, ich habe eine ExcelTabelle in der in verschiedenen Zeilen, Reihen, Zellen Email-Adressen stehen die ich gerne herausgefiltert haben möchte. Leider bin ich kein ASS im Makro programmieren, deswegen benötige ich eure Hilfe. Ich möchte, dass mir Excel über einen Klick auf eine Schaltfläche in einem Hinweisfenster alle Email Adressen aus der ExcelTabelle aufilstet. Kann mir jemand helfen? Vielen Dank schon einmal

Expertenantwort
von Ninombre, Community-Experte für Excel, 29

Hinter den Klick auf die Schaltfläche folgendes legen:

Sub suche()
Dim rCell As Range
Dim rRng As Range
Dim ergebnisspalte As Integer
Set rRng = Range("A1:C10")
ergebnisspalte = 12
For Each rCell In rRng.Cells
If InStr(1, rCell, "@", vbTextCompare) > 0 Then Cells(Cells(Rows.Count, ergebnisspalte).End(xlUp).Row + 1, ergebnisspalte).Value = rCell
Next rCell
End Sub

Anpassen musst Du die Definition des Suchbereichs (hier A1:C10) und die Spalte, in der die gefundenen E-Mail Adressen gelistet werden (hier 12 = Spalte L -> in VBA numerisch angeben).

Bei dem Beispiel bin ich davon ausgegangen, dass in einer Zelle nur die E-Mail Adresse steht und der komplette Zelleninhalt kopiert werden kann. Wenn in einer Zelle noch anders steht, muss man etwas mehr abfragen.

Kommentar von kikichog ,

Super Danke schonmal, wie gebe ich an dass ich die Lösung in dem nächsten Tabellenblatt angezigt haben möchte? (anstatt wie bei die in 12 = L?)

Kommentar von kikichog ,

ach, und wie kann ich gleichzeitig noch Duplikate löschen?

Kommentar von Ninombre ,

Noch mal etwas andere Version. Du musst neben dem Suchbereich und der Ergebnisspalte noch die Tabellennamen an Deinen konkreten Fall anpassen, bei mir was das halt Tabelle2 und Tabelle 4. Vor dem Kopieren wird geprüft, ob es diesen Eintrag schon gibt (wenn ja-> nix kopieren)

Sub suche()
Dim rCell As Range
Dim rRng As Range
Dim ergebnisspalte As Integer
Dim quelle As String
Dim ziel As String
quelle = "Tabelle2"
ziel = "Tabelle4"
Set rRng = Sheets(quelle).Range("A1:C10")
ergebnisspalte = 12
For Each rCell In rRng.Cells
If InStr(1, rCell, "@", vbTextCompare) > 0 And WorksheetFunction.CountIf(Sheets(ziel).Columns(ergebnisspalte), rCell) = 0 Then Sheets(ziel).Cells(Cells(Rows.Count, ergebnisspalte).End(xlUp).Row + 1, ergebnisspalte).Value = rCell
Next rCell
End Sub

Keine passende Antwort gefunden?

Fragen Sie die Community

Weitere Fragen mit Antworten