Code funkttioniert nur einmal

Hallo,
mit folgendem Code wähle ich einen Eintrag in einer ListBox (UF) aus.

Private Sub ListBox1_Click()
Dim i As Long, lr As Integer
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To lr
If Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = Sheets("Data").Cells(i, 6) Then
Me.TextBox1.Value = Sheets("Data").Cells(i, 7)
Me.TextBox2.Value = Sheets("Data").Cells(i, 8)
Me.TextBox3.Value = Sheets("Data").Cells(i, 9)
Me.TextBox4.Value = Sheets("Data").Cells(i, 10)
Me.TextBox5.Value = Sheets("Data").Cells(i, 11)
Me.TextBox6.Value = Sheets("Data").Cells(i, 12)
Me.TextBox7.Value = Sheets("Data").Cells(i, 13)
Me.TextBox8.Value = Sheets("Data").Cells(i, 14)
Me.TextBox9.Value = Sheets("Data").Cells(i, 15)
Me.TextBox10.Value = Sheets("Data").Cells(i, 16)
Me.TextBox11.Value = Sheets("Data").Cells(i, 17)
Me.TextBox12.Value = Sheets("Data").Cells(i, 18)
Me.TextBox13.Value = Sheets("Data").Cells(i, 19)
Me.TextBox14.Value = Sheets("Data").Cells(i, 20)
Me.TextBox15.Value = Sheets("Data").Cells(i, 21)
Me.TextBox16.Value = Sheets("Data").Cells(i, 22)
Me.TextBox17.Value = Sheets("Data").Cells(i, 23)
Me.TextBox18.Value = Sheets("Data").Cells(i, 24)
Me.TextBox19.Value = Sheets("Data").Cells(i, 25)
Me.TextBox20.Value = Sheets("Data").Cells(i, 26)
End If
Next
End Sub