• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veri Kaynağı Oluşturma?

  • Konbuyu başlatan Konbuyu başlatan erar66
  • Başlangıç tarihi Başlangıç tarihi
Katılım
23 Nisan 2014
Mesajlar
19
Excel Vers. ve Dili
w.ms.excel 2010
Uzun zamandır bu siteyi takip ediyorum ve başka konulara verilen cevaplar çok işimi gördü.

Siz değerli dostlardan bir türlü bulamadığım bir kod paylaşmanızı istiyorum.
Ben excelde bir sayfada oluşturulan çeşitli verileri belirlenen bir sayfaya (ilk satır ilgili verilerin başlıkları olacak ör: ad, soyad, T.C. kimlik no vs.) kayıt etmesini istiyorum ve kayıt eder iken de önceki kayıtlar mutlaka muhafaza edilmeli ve yeni verileri takip eden alttaki boş satıra kaydedilmeli.

Ör: sayfa1 deki A3 (isim),B4 (soy isim),C7 (doğum tarihi) gibi hücrede yer alan değerleri sayfa2 de ilgili başlıklarının altındaki ilk boş hücreye misal A sütünu isim ise ve öncesinden a4'e kadar kayıt varsa yeni kaydı a5'e sayfa1 deki a3 (isim) girdisini otomatik kopyalasın. Aynı zamanda da belgeyi kayıt etsin.

Bu kod yaklaşık 10.000 kaydı kaldıracak şekilde olmalı.

Cevaplarınız ve yardımlarınız için çok teşekkür ederim şimdiden.
 
Son düzenleme:
Doğru şekilde yardım alabilmeniz için kendi dosyanızla uyumlu örnek bir dosya paylaşınız.
 
Aşağıda yer alan excel belgesinde gösterdiğim gibi 1. sayfadaki verileri 2. sayfaya taşıyarak ilgili başlığın altındaki ilk boş satıra kayıt yapmasını istiyorum makronun. Burada blok halinde yani veri grubunun tamamı belirli bir satıra kayıt edilmesi gerekiyor. Eğer veri giriş sayfasında herhangi bir veri boş olsa dahi veri boş olan ilk satıra değil, diğer bilgiler ile uyumlu olan satırda olmalıdır. Mutlaka ve mutlaka ilk satır dolu olacak (yani T.C. no) diğer verilerden bir kaçı boş olabilir.

Excel belgesini indirmek için tıklayınız...

Yardımlarınız için içten teşekkür ederim.
 
Son düzenleme:
Merhaba,
Aşağıdaki kodu deneyiniz.
Kod:
Sub KOD()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
satır = s2.Range("A65500").End(3).Row + 1
sütunlar = Array(3, 7, 10)
For Each s In sütunlar
    For a = 4 To 9
        sütun = s2.Range("1:1").Find(s1.Cells(a, s), LookAt:=xlWhole).Column
        s2.Cells(satır, sütun) = s1.Cells(a, s + 1)
    Next
Next
MsgBox "Aktarıldı."
End Sub
 
Geri
Üst