Clever-Excel-Forum

Seiten: 1 2

Guten Morgen,

Daten kopieren, transponieren, Autofilter drüber legen, nach @ filtern, fertig ;)

Alternativ kannst Du auch "@" exkludieren und die gefilterten Werte löschen.

Hallo Rene,

mit VBA, Chris´Code aus Beitrag #4 etwas erweitert:

Sub tilkuw()

  Dim rng As Range, arrMail(), rngCell As Range, i As Integer

  On Error Resume Next

  Set rng = Cells.SpecialCells(xlCellTypeConstants, 2)

  If Err.Number <> 0 Then MsgBox "Keine Zellen mit Inhalt gefunden", vbCritical: Exit Sub

  On Error GoTo 0

  For Each rngCell In rng

      If InStr(1, rngCell, "@") > 0 Then

          ReDim Preserve arrMail(0, i)

          arrMail(0, i) = rngCell

          arrMail(0, i) = Mid(arrMail(0, i), 2, Len(arrMail(0, i)) - 3)

          i = i + 1

      End If

  Next

  Sheets.Add After:=Sheets(Sheets.Count)

  For i = 1 To i - 1

    ActiveSheet.Hyperlinks.Add _

    Anchor:=Cells(i, 1), _

    Address:="mailto:" & arrMail(0, i), _

    TextToDisplay:=arrMail(0, i)

  Next i

End Sub

Gruß Uwe

Seiten: 1 2

Jonas0806

Kuwer