Soru Düşeyaralı Makroyu Çoklu Veride Çalıştırmak

[Rheago]

Merhaba arkadaşlar.

Üzerinde çalıştığım tabloda düşeyarayı makro ile dolu olan hücrelerin yanına ekletip formülü kaldırtıyorum aşağıdaki makro ile. Şöyle bir sorunum var:
Örnek veriyorum E hücresi "ABC" ye eşit ise H,I,J sütunlarına gerekli veriler Data sayfasından geliyor. Fakat data sayfasındaki verileri ben elle tek tek veri girince çekiyor.
Yani ben E sütununa 4 tane alt alta veri yapıştırsam 4 tanesine de uygulamıyorum. Bu işlemi nasıl birden fazla düzeltme ile çalışmasını sağlayabilirim?
Çünkü ben verileri kopyaladığım da örnek veriyorum E10,E11,E12,E13,E14 hücrelerine direkt verileri yapıştırdığımda yanlarına DATA sayfasındaki verilerin gelmesi için ilk olarak E10 a çift tıklamak ve ardından diğer E11,E12,E13,E14 hücrelerinede çift tıklamam gerek. Ancak o şekilde yanlarına verileri getiriyor. Örnek dosyam aşağıda yer almaktadır.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Column <> 5 Then Exit Sub
If .Value <> "" Then
Cells(.Row, "H").FormulaR1C1 = "=IFERROR(VLOOKUP(RC5,DATA!R2C1:R20C2,2,0),)"
If Cells(.Row, "H").Value <> "" Then Cells(.Row, "H").Value = Cells(.Row, "H").Value
Cells(.Row, "I").FormulaR1C1 = "=IFERROR(VLOOKUP(RC5,DATA!R2C1:R20C3,3,0),)"
If Cells(.Row, "I").Value <> "" Then Cells(.Row, "I").Value = Cells(.Row, "I").Value
Cells(.Row, "J").FormulaR1C1 = "=IFERROR(VLOOKUP(RC5,DATA!R2C1:R20C4,4,0),)"
If Cells(.Row, "J").Value <> "" Then Cells(.Row, "J").Value = Cells(.Row, "J").Value
Else
Cells(.Row, "H").ClearContents
Cells(.Row, "I").ClearContents
Cells(.Row, "J").ClearContents
End If: End With
End Sub

 

[Rheago]

Desteğinizi rica ederim arkadaşlar.

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub
    Range("H2:J" & Rows.Count).ClearContents
    Son = Cells(Rows.Count, "E").End(3).Row
    If Son > 1 Then
        With Range("H2:H" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:B,2,0),)"
            .Value = .Value
        End With
        With Range("I2:I" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:C,3,0),)"
            .Value = .Value
        End With
        With Range("J2:J" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:D,4,0),)"
            .Value = .Value
        End With
    End If
End Sub

 

[Rheago]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E2:E" & Rows.Count)) Is Nothing Then Exit Sub
    Range("H2:J" & Rows.Count).ClearContents
    Son = Cells(Rows.Count, "E").End(3).Row
    If Son > 1 Then
        With Range("H2:H" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:B,2,0),)"
            .Value = .Value
        End With
        With Range("I2:I" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:C,3,0),)"
            .Value = .Value
        End With
        With Range("J2:J" & Son)
            .Formula = "=IFERROR(VLOOKUP(E2,DATA!A:D,4,0),)"
            .Value = .Value
        End With
    End If
End Sub

Allah Razı olsun hocam. İşime yaradı.