VBA enter value on change

[LUCYtm]

Hi,

I have problems adjusting my VBA code to apply when not only cell by cell value is entered but when I paste several cells in column D.
I think it works OK when I enter value for example in cell d4, but when I try to paste values from D4 trough D8, only values are pasted and other columns stay empty.

Here is my VBA code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, res As Variant
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("d:d")) Is Nothing Then Exit Sub
Set rng = Worksheets("Sheet3").Range("C:G")
res = Application.VLookup(Target, rng, 2, False)
Application.EnableEvents = False
If IsError(res) Then 'code not found
Target.Offset(0, 1).Resize(1, 3).Value = "No data found"
Beep
Else
Target.Offset(0, 1).Value = res
Target.Offset(0, 2).Value = Application.VLookup(Target, rng, 3, False)
Target.Offset(0, 3).Value = Application.VLookup(Target, rng, 4, False)
End If
Application.EnableEvents = True
End Sub

If someone can explain me if this formula can be fixed or this is not a proper way to 'Autofill' the columns.

Thank you

Bye

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, res As Variant, c As Range
If Intersect(Target, Range("d:d")) Is Nothing Then Exit Sub
Set rng = Worksheets("Sheet3").Range("C:G")
For Each c In Target
    res = Application.VLookup(c, rng, 2, False)
    Application.EnableEvents = False
    If IsError(res) Then 'code not found
        c.Offset(0, 1).Resize(1, 3).Value = "No data found"
        Beep
    Else
        c.Offset(0, 1).Value = res
        c.Offset(0, 2).Value = Application.VLookup(c, rng, 3, False)
        c.Offset(0, 3).Value = Application.VLookup(c, rng, 4, False)
    End If
    Application.EnableEvents = True
Next c
End Sub

 

[LUCYtm]

It works perfectly - thank you