Private Sub TextBox1_Change()
Dim oDrop As Object
Dim strList As String, FA As String
Dim Rng As Range, c As Range
Set oDrop = ActiveSheet.Shapes("Drop Down 4").OLEFormat.Object
strList = oDrop.List(oDrop.ListIndex)
With Sheets("Freunde")
Set Rng = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
With Rng
Set c = .Find(strList, , xlValues)
If Not c Is Nothing Then
FA = c.Address
Do
c.Offset(, 1).Value = TextBox1.Text
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FA
End If
End With
End With
End Sub