Sub sendEmails()
Dim rngWerte As Range
Dim rngEmail As Range
Dim iEmail As Integer
Dim strEmail As String
Dim rng As Range
Set rngWerte = Range(Range("D1"), Range("D1").End(xlDown))
Set rngEmail = Range(Range("B1"), Range("B1").End(xlDown))
For Each rng In rngWerte.Cells
iEmail = NumbersInValue(rng.Value)
strEmail = rngEmail.Cells(iEmail, 1).Value
Debug.Print strEmail
Next
End Sub
Function NumbersInValue(text As String) As Integer
Dim iPos As Integer
Dim strOut As String
For iPos = 1 To Len(text)
If IsNumeric(Mid(text, iPos, 1)) Then
strOut = strOut & Mid(text, iPos, 1)
End If
Next
NumbersInValue = strOut
End Function