Otomatik bilgi ekleme

[teyadih]

Kolay gelsin. Sayfa 1 de olup da sayfa 2 de olmayan isimlerin eğer formülü ile sayfa 2 ye eklenmesine ilişkin örnek dosyayı ekte gönderiyorum.
Teşekkür ederim

http://s8.dosya.tc/server5/4t0efq/OTOMATIK_BILGI_EKLEME.rar.html

 

[Korhan Ayhan]

Merhaba,

İlk olarak "sayfa 1" D2 hücresine aşağıdaki formülü uygulayınız.

=EĞER(EĞERSAY('sayfa 2'!B:B;B2)=0;MAK(D$1:D1)+1;"")

Bu formülü ihtiyacınız kadar alt hücrelere sürükleyiniz. Sonra tüm alanı kopyalayıp değere çeviriniz. Yani uyguladığınız alanda formül kalmasın.

Sonra "sayfa 2" sayfasında B12 hücresine aşağıdaki formülü uygulayınız. Bu formülüde yana ve aşağıda doğru ihtiyacınız kadar sürükleyiniz.

=İNDİS('sayfa 1'!$A:$C;KAÇINCI(SATIR($A1);'sayfa 1'!$D:$D;0);SÜTUN())

 

[teyadih]

Merhaba sayın Korhan formül güzel elinize sağlık. Ancak sayfa 1 deki formülleri bozup değer yaptığımız için sonraki ekleneni vermiyor. Yani Sayfa 2 de boş satırda formül olduğunda sayfa 1 e isim ekleyip D ye formül koyup değerler yaptığımda da vermiyor. Eğer sayfa 2 de boş satırda formül yoksa ve her 2 sayfadaki işlemleri her eklenen isimden sonra anlattığınız gibi baştan yaparsam oluyor
Bu durumda her kişi eklediğimde aynı işlemleri yapmam gerekecek. Sayfa 1 ile sayfa 2 farklı çalışma sayfasında olduğu ve sayfa 2 yi sürekli kullanmadığımdan unutmamak için böyle bir formül istemiştim.
Sayın Korhan sizi yoruyorum ama sayfa 1 deki formülü bozmadan isim eklendiğinde otomatik atacak şekilde yapabilir misiniz acaba
Umarım anlatabilmişimdir. Teşekkür ederim.

 

[Korhan Ayhan]

Bu işlem için makro kullanmanız gerekiyor.

Aşağıdaki kodu deneyiniz.

Sub EKSİK_PERSONELLERİ_AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Son As Long, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("sayfa 1")
    Set S2 = Sheets("sayfa 2")
    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
    
    For X = 2 To Son
        If WorksheetFunction.CountIf(S2.Range("B:B"), S1.Cells(X, "B")) = 0 Then
            Satir = S2.Cells(S2.Rows.Count, "A").End(3).Row + 1
            S2.Cells(Satir, "A") = S2.Cells(Satir - 1, "A") + 1
            S2.Cells(Satir, "B") = S1.Cells(X, "B")
            S2.Cells(Satir, "C") = S1.Cells(X, "C")
            Say = Say + 1
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    If Say > 0 Then
        MsgBox "Eksik personeller listeye eklenmiştir." & Chr(10) & Chr(10) & _
               "Eklenen personel sayısı ; " & Say, vbInformation
    Else
        MsgBox "Eksik personel bulunamadı !", vbExclamation
    End If
End Sub

 

[teyadih]

Anladım sayın Korhan makro ile ilgili bilgim yok nasıl eklemem gerektiğini ayrıntılı olarak anlatabilir misiniz

 

[Korhan Ayhan]

Dosyanızı açın.
ALT+F11 tuşlarına basın.
Karşınıza kod editörü gelecektir.
INSERT menüsünden MODULE seçeneğini seçin.

Verdiğim kodu sağ tarafta görünen beyaz alana uygulayın.
Dosyanızı farklı kaydet yaparak "Makro İçerebilen Excel Çalışma Kitabı" biçiminde kayıt edin.
Excel sayfasına dönün sayfanıza bir şekil ya da buton ekleyin.
Şekil ya da buton üzerinde sağ klik yapın ve MAKRO ATA komutunu uygulayın.

Son olarak butona tıklayıp kodu çalıştırın.

 

[teyadih]

sayın korhan http://www.excel.web.tr/f14/dolu-olan-satyrlary-birle-tirme-t168909.html sayfasındaki makro ile bu sayfadaki makro aynı çalışma kitabında olacak en iyisi ben son halini verip size tekrar örnek dosya göndereyim her ikisi içinde
teşekkür ederim kolay gelsin