Sub Diapazon()
Dim i As Long
Dim n As Long
Dim iLastRow As Long
Dim arr
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   Range("B2:B" & iLastRow).ClearContents
   arr = Range("A2:F" & iLastRow).Value
   For i = LBound(arr) To UBound(arr)
     For n = LBound(arr) To UBound(arr)
       If arr(i, 1) >= arr(n, 4) And arr(i, 1) <= arr(n, 5) Then
          arr(i, 2) = arr(n, 6)
          Exit For
       End If
     Next
   Next
   Range("A2").Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub