CommandButton Yardımıyla Başka Sayfaya Veri Taşıma

A

anaksimandros

Katılım
2 Mayıs 2011
Mesajlar
33
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
30-10-2020
Kolay gelsin arkadaşlar.

UserForm yardımıyla üye kayıt, bulma, güncelleme işlemleri yapıyorum. Buraya yeni bir commandbutton (Üye Taşı) eklemek istiyorum.

- "Üye bul" butonu yardımıyla veritabanından (Veritabanı) üyeyi bulup ilgili textbox'lara verileri getirecek. ("Üye Bul" butonum mevcut ve çalışıyor")
- "Üye Taşı" butonuna basıldığında Veritabanı'daki üye verilerini Sayfa2'ye aktaracak. Aktarılan verileri (Veritabanı) sayfasında ilgili satırdan silecek.

Başka bir konuda "çıtır" kullanıcı adlı arkadaş bunu excel sayfasında açılır kutu yardımıyla yapmıştı ve paylaşmıştı. O kodu modifiye edemedim. Yardımcı olacak arkadaşlar için ilgili dosyayı da paylaşıp yardımlarınızı bekliyorum.
 

Ekli dosyalar

A

anaksimandros

Katılım
2 Mayıs 2011
Mesajlar
33
Excel Vers. ve Dili
2010
Altın Üyelik Bitiş Tarihi
30-10-2020
İşleri öğrenince iş başa düştü ve cevabını da kendim buldum. Buraya bırakalım belki faydalanan olabilir.

İlk olarak bul butonu yardımıyla veritabanından ilgili kaydı bulup userform'a çağıracağımız kod.

Kod: 
Private Sub bul_Click()
On Error GoTo Bitir
    aranan = InputBox("Bulmak istediğiniz kişinin tam ad ve soyadı giriniz.", "Arama Kutusu", "")
    Range("C:C").Find(aranan).Select
    sil_satır = ActiveCell.Row
        id.Value = Worksheets("Sayfa1").Cells(sil_satır, "A")
        kurum_sicil.Value = Worksheets("Sayfa1").Cells(sil_satır, "B")
        adi_soyadi.Value = Worksheets("Sayfa1").Cells(sil_satır, "C")
        opterkek.Value = IIf(Worksheets("Sayfa1").Cells(sil_satır, "D") = "Erkek", True, False)
        optkadin.Value = IIf(Worksheets("Sayfa1").Cells(sil_satır, "D") = "Kadın", True, False)
      
Exit Sub
Bitir:

MsgBox "Aradığınız personel veritabanında bulunamadı."
End Sub
Alttaki kod da bulduğumuz veriyi başka bir sayfaya aktarma kodu.
Kod: 
Private Sub tasi_Click()
    If id.Value <> "" Then
          
        
        Dim Komut As Integer
        Dim Mesaj As String
        Dim Baslik As String
    
        Mesaj = adi_soyadi.Value & " adlı personel, veritabanından kaldırılacaktır."
        Baslik = "Silme İşlemi"
        Komut = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
        
            If Komut = 6 Then
            
            UserForm3.Show
                        
            SonSatır = WorksheetFunction.CountA(Worksheets("Sayfa2").Range("A:A")) + 1
    
        If SonSatır = 2 Then
            Worksheets("Sayfa2").Cells(SonSatır, "A") = 1
            Worksheets("Sayfa2").Cells(SonSatır, "B") = kurum_sicil.Value
            Worksheets("Sayfa2").Cells(SonSatır, "C") = adi_soyadi.Value
            Worksheets("Sayfa2").Cells(SonSatır, "D") = IIf(opterkek.Value, "Erkek", "Kadın")
                    
        Else
            Worksheets("Sayfa2").Cells(SonSatır, "A") = Worksheets("Sayfa1").Cells(SonSatır - 1, "A") + 1
            Worksheets("Sayfa2").Cells(SonSatır, "B") = kurum_sicil.Value
            Worksheets("Sayfa2").Cells(SonSatır, "C") = adi_soyadi.Value
            Worksheets("Sayfa2").Cells(SonSatır, "D") = IIf(opterkek.Value, "Erkek", "Kadın")
        End If
            MsgBox "Personel başarıyla taşınmıştır."
            
                Rows(ActiveCell.Row).Delete
                    id.Value = ""
                    kurum_sicil.Value = ""
                    adi_soyadi.Value = ""
                    opterkek.Value = ""
                    optkadin.Value = ""
            Else
                MsgBox "Silme işlemi iptal edilmiştir."
            End If
    
    Else
    
        MsgBox "Öncelikle -Bul- butonu yardımıyla bir kayıt seçiniz.", vbExclamation
    End If
End Sub
 
D

demirpc

Katılım
30 Ocak 2022
Mesajlar
1
Excel Vers. ve Dili
excel vba
anaksimandros' Alıntı:
İşleri öğrenince iş başa düştü ve cevabını da kendim buldum. Buraya bırakalım belki faydalanan olabilir.

İlk olarak bul butonu yardımıyla veritabanından ilgili kaydı bulup userform'a çağıracağımız kod.

Kod: 
Private Sub bul_Click()
On Error GoTo Bitir
    aranan = InputBox("Bulmak istediğiniz kişinin tam ad ve soyadı giriniz.", "Arama Kutusu", "")
    Range("C:C").Find(aranan).Select
    sil_satır = ActiveCell.Row
        id.Value = Worksheets("Sayfa1").Cells(sil_satır, "A")
        kurum_sicil.Value = Worksheets("Sayfa1").Cells(sil_satır, "B")
        adi_soyadi.Value = Worksheets("Sayfa1").Cells(sil_satır, "C")
        opterkek.Value = IIf(Worksheets("Sayfa1").Cells(sil_satır, "D") = "Erkek", True, False)
        optkadin.Value = IIf(Worksheets("Sayfa1").Cells(sil_satır, "D") = "Kadın", True, False)
     
Exit Sub
Bitir:

MsgBox "Aradığınız personel veritabanında bulunamadı."
End Sub
Alttaki kod da bulduğumuz veriyi başka bir sayfaya aktarma kodu.
Kod: 
Private Sub tasi_Click()
    If id.Value <> "" Then
         
       
        Dim Komut As Integer
        Dim Mesaj As String
        Dim Baslik As String
   
        Mesaj = adi_soyadi.Value & " adlı personel, veritabanından kaldırılacaktır."
        Baslik = "Silme İşlemi"
        Komut = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)
       
            If Komut = 6 Then
           
            UserForm3.Show
                       
            SonSatır = WorksheetFunction.CountA(Worksheets("Sayfa2").Range("A:A")) + 1
   
        If SonSatır = 2 Then
            Worksheets("Sayfa2").Cells(SonSatır, "A") = 1
            Worksheets("Sayfa2").Cells(SonSatır, "B") = kurum_sicil.Value
            Worksheets("Sayfa2").Cells(SonSatır, "C") = adi_soyadi.Value
            Worksheets("Sayfa2").Cells(SonSatır, "D") = IIf(opterkek.Value, "Erkek", "Kadın")
                   
        Else
            Worksheets("Sayfa2").Cells(SonSatır, "A") = Worksheets("Sayfa1").Cells(SonSatır - 1, "A") + 1
            Worksheets("Sayfa2").Cells(SonSatır, "B") = kurum_sicil.Value
            Worksheets("Sayfa2").Cells(SonSatır, "C") = adi_soyadi.Value
            Worksheets("Sayfa2").Cells(SonSatır, "D") = IIf(opterkek.Value, "Erkek", "Kadın")
        End If
            MsgBox "Personel başarıyla taşınmıştır."
           
                Rows(ActiveCell.Row).Delete
                    id.Value = ""
                    kurum_sicil.Value = ""
                    adi_soyadi.Value = ""
                    opterkek.Value = ""
                    optkadin.Value = ""
            Else
                MsgBox "Silme işlemi iptal edilmiştir."
            End If
   
    Else
   
        MsgBox "Öncelikle -Bul- butonu yardımıyla bir kayıt seçiniz.", vbExclamation
    End If
End Sub
Genişletmek için tıkla ...
rivate Sub ÇIKIŞ_Click()
If D1.Value <> "" Then

Dim Komut As Integer
Dim Mesaj As String
Dim Baslik As String

Mesaj = D3.Value & " adlı personel, veritabanından kaldırılacaktır."
Baslik = "Silme İşlemi"
Komut = MsgBox(Mesaj, vbYesNo + vbQuestion, Baslik)

If Komut = 6 Then

UserForm1.Show

SonSatır = WorksheetFunction.CountA(Worksheets("ÇIKIŞLAR").Range("A:A")) + 1

If SonSatır = 2 Then
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "A") = 1
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "B") = D2.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "C") = D3.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "D") = D4.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "E") = D5.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "F") = D6.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "G") = D7.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "H") = D8.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "I") = D9.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "J") = D10.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "K") = D11.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "L") = D12.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "M") = D13.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "N") = D14.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "O") = D15.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "P") = D16.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Q") = D17.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "R") = D18.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "S") = D19.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "T") = D20.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "U") = D21.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "V") = D22.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "W") = D23.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "X") = D24.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Y") = D25.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Z") = D26.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AA") = D27.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AB") = D28.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AC") = D29.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AD") = D30.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AE") = D31.Value

Else
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "A") = Worksheets("Sheet1").Cells(SonSatır - 1, "A") + 1
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "B") = D2.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "C") = D3.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "D") = D4.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "E") = D5.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "F") = D6.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "G") = D7.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "H") = D8.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "I") = D9.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "J") = D10.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "K") = D11.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "L") = D12.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "M") = D13.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "N") = D14.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "O") = D15.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "P") = D16.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Q") = D17.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "R") = D18.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "S") = D19.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "T") = D20.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "U") = D21.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "V") = D22.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "W") = D23.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "X") = D24.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Y") = D25.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "Z") = D26.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AA") = D27.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AB") = D28.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AC") = D29.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AD") = D30.Value
Worksheets("ÇIKIŞLAR").Cells(SonSatır, "AE") = D31.Value

End If
MsgBox "Personel başarıyla taşınmıştır."

Rows(ActiveCell.Row).Delete

D1.Value = ""
D2.Value = ""
D3.Value = ""
D4.Value = ""
D5.Value = ""
D6.Value = ""
D7.Value = ""
D8.Value = ""
D9.Value = ""
D10.Value = ""
D11.Value = ""
D12.Value = ""
D13.Value = ""
D14.Value = ""
D15.Value = ""
D16.Value = ""
D17.Value = ""
D18.Value = ""
D19.Value = ""
D20.Value = ""
D21.Value = ""
D22.Value = ""
D23.Value = ""
D24.Value = ""
D25.Value = ""
D26.Value = ""
D27.Value = ""
D28.Value = ""
D29.Value = ""
D30.Value = ""
D31.Value = ""
Else
MsgBox "Silme işlemi iptal edilmiştir."
End If

Else

MsgBox "Öncelikle -Bul- butonu yardımıyla bir kayıt seçiniz.", vbExclamation
End If

End Sub

ben de userform1.show hatası veriyor
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst