Sub FillIn()
Dim ws As Worksheet, lr As Long, rngData As Range, r As Range
Set ws = Worksheets("DetailedTBFY15")
Application.ScreenUpdating = False
    With ws
        lr = .Cells(Rows.Count, "B").End(xlUp).row
        Set rngData = .Range("B5:B" & lr)
    End With
    With rngData.SpecialCells(4)
            For Each r In .Areas
                r.Value = r(0).Value
            Next r
    End With
Application.ScreenUpdating = True
End Sub