Find Text Drag Row Above

Try this...

Sub FindDataAndFill()
Dim rFound As Range

With Columns("D:D")
    Set rFound = .Find(What:="Dividend", After:=.Cells(1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
End With
    
If Not rFound Is Nothing Then
    rFound.Offset(, -1).Resize(, 8).FillDown
End If

End Sub

Perfect

Thanks Very muchly

Me very happy

You are great