Private Sub CommandButton1_Click()
Dim Tablo(), LstRw&, RwsCnt&, X&, i&, j&
LstRw = Cells(Rows.Count, 1).End(xlUp).Row
RwsCnt = LstRw - 8
ReDim Tablo(1 To 24, 1 To RwsCnt)
For i = 9 To Cells(Rows.Count, 10).End(xlUp).Row
X = 0
For j = 9 To LstRw
If Cells(j, 2).Value <= Cells(i, 10).Value And _
Cells(j, 3).Value >= Cells(i, 10).Value Then
X = X + 1
Tablo(i - 8, X) = Cells(j, 1).Value
End If
Next j
Next i
Cells(9, 11).Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
End Sub