Excel Üye Yönetimi

[Emson]

Merhaba herkese iyi çalışmalar diliyorum.

Bir üye verim var ve ilçelere göre sayfalara ayırdım
bu üyeleri tek bir listede 1 buton ile toplamak istiyorum yazıcıdan rahatlıkla çıkarabilmek için
üye ekleme silme işlemi yapabilmek, üye bilgilerini çekme gibi işlemler yapmak istiyorum yardımcı olabilecek var mı aslında askerdeyken güzel bir makro çalışması yapmıştım kendime üzerinden 3-4 yıl geçti hiç bir kodu hatırlamıyorum

 

[Emson]

Private Sub Corlu_Aktar_Click()
    With Sheets("Çorlu")
        Set Ad_Soyad = .Range("B4:B4" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        Set ikamet = .Range("C4:C4" & .Cells(.Rows.Count, 1).End(xlUp).Row)
        Set plaka = .Range("D4:D4" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With
    
    With Sheets("Tek_Liste")
    Sheets("Tek_Liste").Range("B:D").ClearContents
    
        .Range("B4:B" & Rows.Count) = ""
        .Range("B4").Resize(Ad_Soyad.Rows.Count, 1) = Ad_Soyad.Value
        .Range("C4").Resize(ikamet.Rows.Count, 1) = ikamet.Value
        .Range("D4").Resize(plaka.Rows.Count, 1) = plaka.Value
        Sheets("Tek_Liste").Select
        
    End With
End Sub

burda mesela çorluda ki üyeleri çekebiliyorum fakat kapaklıda da üyelerim var çorludan üye çektikten sonra 27.satır boş mesela ordan itibarende kapaklıyı çekmesini istiyorum

 

[tukayf]

Merhabalar. Örnek dosyanızı yükleyin muhakkak yardımcı olan olacaktır.

 

[Emson]

Dosya

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub Birlestir()

Dim syf As Worksheet, _
    sht As Worksheet, _
    i   As Long, _
    j   As Long

    Application.ScreenUpdating = False
    
    Set sht = Sheets("Tek_Liste")
    sht.Range("A4:F" & Rows.Count).ClearContents
    
    For Each syf In ThisWorkbook.Sheets
    
        If Not syf.Name = "Uye_Ekle" And _
           Not syf.Name = "Ana_Sayfa" And _
           Not syf.Name = "Tek_Liste" Then
           j = syf.Cells(Rows.Count, "B").End(3).Row
           If j > 3 Then
                i = sht.Cells(Rows.Count, "B").End(3).Row + 1
                If i < 4 Then i = 4
                syf.Range("B4:D" & j).Copy sht.Range("B" & i)
           End If
        End If
        
    Next syf
    
    i = sht.Cells(Rows.Count, "B").End(3).Row
    sht.Range("A4") = 1
    sht.Range("A4:A" & i).DataSeries
    Application.ScreenUpdating = True
    MsgBox "Veriler Tek_Liste Sayfasında toplanmıştır...."
    
End Sub

 

[Emson]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub Birlestir()

Dim syf As Worksheet, _
    sht As Worksheet, _
    i   As Long, _
    j   As Long

    Application.ScreenUpdating = False
   
    Set sht = Sheets("Tek_Liste")
    sht.Range("A4:F" & Rows.Count).ClearContents
   
    For Each syf In ThisWorkbook.Sheets
   
        If Not syf.Name = "Uye_Ekle" And _
           Not syf.Name = "Ana_Sayfa" And _
           Not syf.Name = "Tek_Liste" Then
           j = syf.Cells(Rows.Count, "B").End(3).Row
           If j > 3 Then
                i = sht.Cells(Rows.Count, "B").End(3).Row + 1
                If i < 4 Then i = 4
                syf.Range("B4:D" & j).Copy sht.Range("B" & i)
           End If
        End If
       
    Next syf
   
    i = sht.Cells(Rows.Count, "B").End(3).Row
    sht.Range("A4") = 1
    sht.Range("A4:A" & i).DataSeries
    Application.ScreenUpdating = True
    MsgBox "Veriler Tek_Liste Sayfasında toplanmıştır...."
   
End Sub

Çok teşekkür ederim kodların ne işlev gördüğünü anlamasam da işimi görüyor şuanlık ekstra çorluya yeni üye eklediğimde butona basınca Tek_Liste ye eklicek mi veya orayı boşaltıp tekrar mı geçirecek

 

[Necdet]

tüm sayfaları bir seferde tek sayfada topluyor.

Sorunuzu öyle anladığım için o şekilde yaptım.
Çok zaman almadığı için bu şekilde kullanabilirsiniz.
Diğer şekilde sayfalarda aktarılıp aktarılmadığına dair kontrol etmek gerek.

 

[Emson]

Anladım üye_ekle sayfasında çorlu çerkezköy diye yukarıda kutucuklar oluşturdum görmüşsündür bu kutulara Ana_Sayfada ki çorluda kaç kişi var o sayıları çekmek istiyorum kişi eklediğimde boş dolu say ile ana sayfada anlık değişim sağlıyor burda sağlamıyor buton ile tetiklemem gerekiyor