verilerin aktarılması

[labraxs]

İyi çalışmalar. bir excel dosyasında farklı mahalle sayfaları birde genel sayfa oluşturdum, yapmak istediğim ise genel sayfada yazdığım bilgilerin otomatik olarak yazılan mahalle sayfasında tamamının aktarılması ya da o sayfaya kopyalanması yardımlarınız için şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Genel sayfada yazdığınız veriler anında mı ilgili sayfaya aktarılacak?
Aktardıktan sonra kayıt silinecek mi?

Silinmeyecekse tekrar aktar dendiğinde mükerrer kayıtlar oluşmaz mı?

Düşününce çok soru geliyor insanın aklına.

Bunları da bilmeden kod yazmak boşa kürek çekmek anlamına gelir.

 

[pristineli45]

Verilerin aktarılması

Dostum.
Anladığım gibiyse eğer ekteki dosya işini görür gibi

 

[labraxs]

sanırım yanlış anlattım tekrar deneyim gönderdiğim ekte hali hazır olan tabloda genel yazan sayfada yazdığım bilgiler açılmış olan diğer mahalle sayfaların da hangi mahalle yazıldıysa o mahallenin sayfasında otomatik olarak kaydedilsin istiyorum (yazılan bilgiler sonradan silinmeyecek).
Necdet Yeşertener bey evet anında iletilecek ve silinmeyecek (yani bilgi genel sayfada da kalacak mahalle sayfasında da kalacak)
NOT: amacım bilgileri hem genelde görmek hemde mahalle mahalle ayrı görmek (tabi mümkün müdür bilmiyorum) tekrar ilginiz ve yardımlarınız için teşekkürler

 

[labraxs]

pristineli45 arkadaşım senin yaptığın mantık doğru ama isim hanesi değil de mahalle hanesi girildiğinde gruplandırma yapmasını istiyorum. teşekkürler

 

[pristineli45]

Sayfa = Cells(x, "a")
satırındaki "a" yı "c" olarak değiştirin.

 

[Necdet]

Merhaba,

Bir şeyler yapmaya çalıştım, kontrollerde eksik kalan yerler olabilir, dosyayı inceleyiniz.

Amacım doğrudan veri giriş yaparken çaktırmadan da girilen verilerin ilgili sayfalara aktarılmasını sağlamaktı. Başarılı oldum mu bilemiyorum ayrıntılı incelemeyi dosya üzerinde yapınız.

Aşağıdaki kod ThisWorkBook(BuÇalışmaKitabı)'un kod bölümünde olmalı. Dosyayı açtığınızda her Enter'a basıldığında yönü sağa dönüştürür, çıkışta ise aşağıya çevirir.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Application.MoveAfterReturnDirection = xlDown
End Sub
Private Sub Workbook_Open()
    
    Application.MoveAfterReturnDirection = xlToRight
End Sub

Aşağıdaki kodlar "Genel" sayfasının kod bölümünde olmalı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.Row < 2 Or Target.Column < 6 Or Selection.Count > 1 Then Exit Sub
    If Target.Column = 6 Then
        With Target.Font
            .Name = "Wingdings"
        End With
        If Target.Value = "" And Application.WorksheetFunction.CountA(Range("A" & Target.Row & ":D" & Target.Row)) > 3 Then
            Target.Value = "ü"
            Aktar Target.Row
            Range("A" & Target.Row + 1).Activate
        Else
            Exit Sub
        End If
    ElseIf Target.Column > 6 Then
        Range("A" & Target.Row + 1).Activate
    End If
    
End Sub

Aşağıdaki kodlar ise bir Modul'de olmalı.

Sub Aktar(Sat As Long)
    
    Dim ShG As Worksheet, _
        Syf As String, _
        i   As Long
    
    Set ShG = Sheets("GENEL")
    Syf = Application.WorksheetFunction.Proper(Trim(ShG.Cells(Sat, "C")))
    If ShG.Cells(Sat, "C") = "" Then Exit Sub
    
    'Sayfa Yoksa AÇAR
    If Not SayfaVarMi(Syf) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Syf
        ShG.Range("A1:E1").Copy
        Range("A1").Select
        ActiveSheet.Paste
        Selection.PasteSpecial Paste:=xlPasteColumnWidths
        ShG.Select
    End If
    
    i = Sheets(Syf).Cells(Rows.Count, "A").End(3).Row + 1
    Range("A" & Sat & ":E" & Sat).Copy Sheets(Syf).Range("A" & i)
    
End Sub
Function SayfaVarMi(SayfaAdi As String) As Boolean
    
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
    
End Function

Telefon numaralarında doğrudan telefonu yazınız. İlinizi ilgilendiriyorsa 1234567, cep telefonu ise 5321234567 gibi giriniz. Biçimlendirme otomatik olacaktır. Biçimlendirmeyi de inceleyiniz.

 

[labraxs]

Yardımlarınız ve ilginiz için teşekkürler.