code doesn't work bring multiple values based on one value

I had a very tough time trying to understand what you want to do. I hope it is what the code below does. Please try it. Also read the comments carefully.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 109 - 31 Oct 2020

    Dim Rng         As Range
    Dim R           As Long

    With Target
        If .CountLarge > 1 Then Exit Sub

        ' set up the trigger range
        Set Rng = Range(Cells(3, "D"), Cells(Rows.Count, "D").End(xlUp))
        ' no action if change wasn't within the trigger range
        If Not Application.Intersect(Target, Rng) Is Nothing Then
            ' target cells next to the trigger cell must be blank
            ' set up the range required to be blank
            Set Rng = Range(Cells(.Row, "A"), Cells(.Row, "E"))
            If WorksheetFunction.CountA(Rng) = 1 Then       ' skip if not blank (all but column D)

                ' set up the look-up range
                ' exclude all rows above Target.Row
                Set Rng = Range(Cells(2, "D"), Cells(.Row - 1, "D"))

                ' find the row where Taget.Value is found in column D
                On Error Resume Next
                R = WorksheetFunction.Match(.Value, Rng, 0)
                If R Then
                    R = R + Rng.Row - 1
                    Cells(.Row, "B").Value = Cells(R, "B").Value
                    Cells(.Row, "E").Value = Cells(R, "E").Value
                    Cells(.Row, "F").Value = Cells(R, "F").Value
                End If
                Err.Clear
            End If
        End If
    End With
End Sub