üst satırlara bakarak aynı verileri yazdırma

[yellow]

Arkadaşlar üst satırlarda önceden girdiğim verilere bakarak alt satırlarda verileri otomatik doldurmak istiyorum yardımcı olan arkadaşlara şimdiden teşekkürler.

 

[Murat OSMA]

Şu kodları Sayfanın kod bölümüne yazıp deneyiniz;

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo hata
    Dim bak As Range
    For Each bak In Range("A2:A" & Range("A65536").End(3).Row)
        If bak.Value = Target.Value Then
            Cells(bak.Row, 1).Resize(, 4).Copy Target
        End If
    Next bak
hata:
End Sub

 

[yellow]

Sayın murat osma ilginiz için teşekkür ederim a ve b sutunu yazılı geliyor o yüzden sadece c ve d sutünu otamatik yazacak bir de bir düğmeye bağlayıp tıkladıkça yapabilirmi

 

[yellow]

arkadaşlar yardımcı olursanız sevinirim

 

[yellow]

arkadaşlar lütfen yardımcı olur musunuz

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub Doldur()
    
    Dim Son As Long, _
        i   As Long, _
        c   As Range, _
        Adr As String
        
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        If Cells(i, "C") = "" Then
            With Range("a1:a" & i - 1)
                Set c = .Find(Cells(i, "A"), LookIn:=xlValues)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        If Cells(c.Row, "B") = Cells(i, "B") Then
                            Cells(i, "C") = Cells(c.Row, "C")
                            Cells(i, "D") = Cells(c.Row, "D")
                        End If
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır...", vbInformation, "N. YEŞERTENER"
    
End Sub

 

[yellow]

Necdet bey çok teşekkür ederim saol kolay gelsin

 

[yellow]

Necdet hocam affınıza sığınarak bir sorum daha olacak üst satırdaki eğer boşsa diğer satırdaki bilgileride siliyor üst satırdaki boşsa alt satırlara bakarak verileri doldurabilirmiyiz şimdiden teşşekkürler

 

[yellow]

arkadaşlar yardımcı olursanız sevinirim

 

[yellow]

değerli hocalarım yardımlarınızı bekliyorum.

 

[forever215]

Merhaba;

Bu kod işinizi görür yalnız YOK olarak yazdıramadım bulunca tekrar geri dönüş yaparım

Sub ara()
Dim bulunanSatir As Range
Dim bul As String
For i = 2 To Range("A65536").End(3).Row
Set bulunanSatir = Range("A:A").Find(Range("A" & i))
Range("C" & i) = bulunanSatir.Offset(0, 2).Value
Range("D" & i) = bulunanSatir.Offset(0, 3).Value
Next i
End Sub

 

[yellow]

Merhaba;

Bu kod işinizi görür yalnız YOK olarak yazdıramadım bulunca tekrar geri dönüş yaparım

Sub ara()
Dim bulunanSatir As Range
Dim bul As String
For i = 2 To Range("A65536").End(3).Row
Set bulunanSatir = Range("A:A").Find(Range("A" & i))
Range("C" & i) = bulunanSatir.Offset(0, 2).Value
Range("D" & i) = bulunanSatir.Offset(0, 3).Value
Next i
End Sub

bu kod işimi görüyor ama yukarı satırlarda boş varsa aşağıda dolu olan satırıda siliyor bunu nasıl düzeltebilirim