Veri Giriş Hücrelerine Formül Yazmadan Otomatik Veri Alma

[Amaxx]

Günaydın Arkadaşlar,

Yaptığım çalışmada ihtiyacım olan formül/kod için küçük bir örnek dosya hazırladım. Bu dosyada girilecek standart verileri önceden liste halinde hazırladım. Bu verileri standart ürünlerde otomatik almak istiyorum. Standart ürün olmadığında verileri manuel girip Stndart Listenin Altına kaydetmek istiyorum.

Standart dışı veriler gireceğim için Veri Giriş Hücrelerinin boş (formülsüz) olmasını istiyorum bu yüzden Düşey Ara yöntemini burada kullanamıyorum.

 

[dEdE]

Merhaba,
Dosyanız ilişiktedir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Set bul = Cells.Find([B2].Value, , , xlWhole)
If Not bul Is Nothing Then
    bul.Select
    [B3].Value = [B20].Value
    [B4].Value = [C20].Value
    [B5].Value = [D20].Value
    [B7].Value = [E20].Value
    [B8].Value = [F20].Value
    [B9].Value = [G20].Value
End If
End Sub

Sub Kaydet()
ssB = [B65536].End(3).Row + 1
Cells(ssB, 2).Value = [B3].Value
Cells(ssB, 3).Value = [B4].Value
Cells(ssB, 4).Value = [B5].Value
Cells(ssB, 5).Value = [B7].Value
Cells(ssB, 6).Value = [B8].Value
Cells(ssB, 7).Value = [B9].Value
End Sub

 

[Amaxx]

Sn. DEDE çok teşekkürler aynen istediğim gibi olmuş. Yalnız Sayfa1 deki tabloyu sayfa2 ye taşıyınca tabi kod çalışmadı. Kendimce kodda Ekteki gibi uyarlama yapmaya çalıştıma ama olmadı :S

 

[Amaxx]

Sn. Dede pardon yanlış yazmışım sayfa adlarını düzelttim oldu :d

elinize sağlık....

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Set bul = Cells.Find([B2].Value, , , xlWhole)
If Not bul Is Nothing Then
bul.Select
Sheets("sayfa1").[B3].Value = Sheets("sayfa2").[B2].Value
Sheets("sayfa1").[B4].Value = Sheets("sayfa2").[C2].Value
Sheets("sayfa1").[B5].Value = Sheets("sayfa2").[D2].Value
Sheets("sayfa1").[B7].Value = Sheets("sayfa2").[E2].Value
Sheets("sayfa1").[B8].Value = Sheets("sayfa2").[F2].Value
Sheets("sayfa1").[B9].Value = Sheets("sayfa2").[G2].Value
End If
End Sub

 

[dEdE]

Sn. Dede pardon yanlış yazmışım sayfa adlarını düzelttim oldu ..

Merhaba,
Önemli olan işe yaraması. İyi çalışmalar..
Bende yanlışlık yapmışım. Kodda bazı satırlar gereksiz silmeyi unutmuşum.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Sheets("sayfa1").[B3].Value = Sheets("sayfa2").[B2].Value
Sheets("sayfa1").[B4].Value = Sheets("sayfa2").[C2].Value
Sheets("sayfa1").[B5].Value = Sheets("sayfa2").[D2].Value
Sheets("sayfa1").[B7].Value = Sheets("sayfa2").[E2].Value
Sheets("sayfa1").[B8].Value = Sheets("sayfa2").[F2].Value
Sheets("sayfa1").[B9].Value = Sheets("sayfa2").[G2].Value
End Sub