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

Katılım
26 Kasım 2007
Mesajlar
308
Excel Vers. ve Dili
Excel 2003
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.
 

Ekli dosyalar

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,607
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
Dosyanız ilişiktedir.

Kod:
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
 

Ekli dosyalar

Katılım
26 Kasım 2007
Mesajlar
308
Excel Vers. ve Dili
Excel 2003
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
 

Ekli dosyalar

Katılım
26 Kasım 2007
Mesajlar
308
Excel Vers. ve Dili
Excel 2003
Sn. Dede pardon yanlış yazmışım sayfa adlarını düzelttim oldu :D:d: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

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,607
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
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.
Kod:
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
 
Son düzenleme:
Üst