Macro ile düşey ara ve Target

[excellkurdu]

Arkadaşlar daha önce açmış olduğum konunun devamı gibi. Bundan dolayı özür dilerim. Çözüldü yazdığı için karıştırmadım.

Makro ile düşey ara kodunu yapamadım.
E sutunundaki bir hücreye tıklayınca R sutunundaki aynı satırdaki değerin G sutunundaki aynı satıra gelmesini istiyorum. Ama bir türlü beceremedim. Örnek dosyam ektedir.
Saygılarımla

Private Sub Worksheet_Change(ByVal Target As Range)
'aktif maddeleri otomatik dolduruyor
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("C5:C10000")) Is Nothing Then GoTo 10
If Target.Value <> "" Then
    Set BUL = Sheets("BiyosidallerFare").Range("A:A").Find(Target.Value, , , xlWhole, , xlNext)
        If Not BUL Is Nothing Then
        Cells(Target.Row, 4) = Sheets("BiyosidallerFare").Range("D" & BUL.Row)
        
10
'Aşağıdaki kodu yapamadım.
'Yukarıdaki kod gibi 10000 satıra kadar gitmeli
    If Intersect(Target, Range("E5")) Is Nothing Then Exit Sub
    Range("G5") = Range("R5") 
   End If
End If
End Sub

 

[Orion1]

Buyurun.

'aktif maddeleri otomatik dolduruyor
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("C5:C10000")) Is Nothing Then GoTo 10
If Target.Value <> "" Then
    Set BUL = Sheets("BiyosidallerFare").Range("A:A").Find(Target.Value, , , xlWhole, , xlNext)
        If Not BUL Is Nothing Then
        Cells(Target.Row, 4) = Sheets("BiyosidallerFare").Range("D" & BUL.Row)
        
10
'Aşağıdaki kodu yapamadım.
'Yukarıdaki kod gibi 10000 satıra kadar gitmeli
    If Intersect(Target, Range("E5:E10000")) Is Nothing Then Exit Sub
    
    Target.Offset(0, 2).Value = Target.Offset(0, 13).Value
        
   End If
End If

 

[excellkurdu]

Hocam hakkınızı helal edin. Allah razı olsun.

 

[Orion1]

Hocam hakkınızı helal edin. Allah razı olsun.

Rica ederim.İyi çalışmalar.