Alfabetik sıraya göre veri aktarma

[kontto]

Arkadaşlar, E6 ile E12 sütunun arasına girdiğim verileri "veri" sayfasına A dan Z ye sıralayarak aktarmasını istiyorum. Aktarırken aynı adsoyad olan varsa "aynı adsoyad dan var" diye beni uyarmasını istiyorum. Veri sayfasına aktarırken şayet "H" ile başlayan bir ad soyad girmiş isem alfabetik sıraya göre veri sayfasına satır ekleyerek aktarması gerekiyor. Örnek dosya gönderiyorum.
Yardımınız için şimdiden teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları ANASAYFA'nın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Intersect(Target, [E6]) Is Nothing Then Exit Sub
    
    Dim ShV As Worksheet
    Dim c   As Range
    
    Set ShV = Sheets("Veri")
        
    Set c = ShV.Range("A:A").Find(Target.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        SatNo = c.Row
        VarYok = True
        Range("E7") = ShV.Range("B" & c.Row)
        Range("E8") = ShV.Range("C" & c.Row)
        Range("E9") = ShV.Range("D" & c.Row)
        Range("E10") = ShV.Range("E" & c.Row)
        Range("E11") = ShV.Range("F" & c.Row)
        Range("E12") = ShV.Range("G" & c.Row)
    Else
        Range("E7") = ""
        Range("E8") = ""
        Range("E9") = ""
        Range("E10") = ""
        Range("E11") = ""
        Range("E12") = ""
        SatNo = ShV.Cells(Rows.Count, "A").End(3).Row + 1
        VarYok = False
    End If
    
End Sub

Aşağıdaki kodları da bir modüle kopyalayınız.

Public SatNo    As Long
Public VarYok   As Boolean
Sub Aktar()
    
    Dim ShA As Worksheet, _
        ShV As Worksheet
    
    Set ShA = Sheets("ANASAYFA")
    Set ShV = Sheets("veri")
    
    If ShA.Range("E6") = "" Then Exit Sub
    
    ShV.Cells(SatNo, "A") = ShA.Range("E6")
    ShV.Cells(SatNo, "B") = ShA.Range("E7")
    ShV.Cells(SatNo, "C") = ShA.Range("E8")
    ShV.Cells(SatNo, "D") = ShA.Range("E9")
    ShV.Cells(SatNo, "E") = ShA.Range("E10")
    ShV.Cells(SatNo, "F") = ShA.Range("E11")
    ShV.Cells(SatNo, "G") = ShA.Range("E12")
    
    If VarYok = False Then
        ShV.Range("A2:G" & SatNo).Sort Key1:=ShV.Range("A1")
    End If
    
    ShA.Range("E6:E12").ClearContents
    
End Sub

ANASAYFA'da adını girdiğiniz zaman var olan bir isimse verilerini getirecek, olmayan isimse boş olarak getirecektir.

Butona bastığınızda ise Veri sayfasına aktarıp sıralayacaktır.

 

[kontto]

Necdet bey ilginizden dolayı teşekkür ederim. Vermiş olduğunuz kodu uygulamaya çalışıyorum ama bir türlü istediğim düzeye getiremedim. Yani aynı kişiden varsa karşıma bir uyarı penceresi çıkabilir mi. Onu değiştirip değiştirmeyeceğimi sorabilir mi.

 

[Necdet]

Necdet bey ilginizden dolayı teşekkür ederim. Vermiş olduğunuz kodu uygulamaya çalışıyorum ama bir türlü istediğim düzeye getiremedim. Yani aynı kişiden varsa karşıma bir uyarı penceresi çıkabilir mi. Onu değiştirip değiştirmeyeceğimi sorabilir mi.

Aynı kişiden veri çıkarsa onun eski verilerini getiriyor, siz isterseniz üzerinde değişiklik yapabilirsiniz. Yoksa boş veri getiriyor.

İkinci bir işlem yapmaya gerek var mı?

 

[kontto]

Bu şekilde de işimi görüyor emeğinize sağlık. Allah zihninizi açık etsin. Sağolun