TextBox lara girilen verilerin Çalışma sayfalarına kopya

[oerbas]

Selamlar ;
A3 Hücresinden Başlamak üzere Sırakıyla TextBox1 içine girilen veri
Arşiv Girişleri olarak adlandırılmış sayfanın A3 Hücresine TextBox2 ye girilen veri B3 Hücresine TextBox3 e girelen veri C3 hücresine atılması gerekiyor. Yeni kayıtlar en son boş satırdan başlamak üzere serekli satırlar haline kayıt işlemi yapılacak Ã?rnek dosya gönderiyorum Yardımlarınıza teşekkür ederim.

 

[xxrt]

Sorunuz;
Userform Üzerinde bulunan4 adet TextBoxa girilen Değerlerin A3,B3,C3 ve D3 Hücresinden itibaren altalta kayıt edilmesi hakkında.
Cevab:
Ã?rnek Dosyanı eklememişsin ama yinede bu kodları denersin.Burada TextBox1'e veri girilmezse Kayıt işlemi yapılmıyor..
Ayrıca Aynı kişi veya sicilden veri kaydını engellemek için ikaz veriyor.

Private Sub CommandButton1_Click()
If TextBox1.Value <> "" Then
Sheets("Sayfa1").Activate
Cells(3, 1).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.TextBox1.Value) Then
If MsgBox(Me.TextBox1 & " Sicil Numaralı İşçi Kaydı Vardır." & " Yeniden Kayıt Yapılsın mı?", vbYesNo, "Mükerrer Kayıt") = vbNo Then Exit Sub
End If
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Value = TextBox1.Value
ActiveCell.Offset(0, 1).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox3.Value
ActiveCell.Offset(0, 3).Value = TextBox4.Value
End If
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
End Sub

Eğer Textboxlara veri girilmesini zorunlu hale getirmek isterseniz;

Private Sub CommandButton1_Click()
'TextBoxa veri girmemesi halinde ikaz
If TextBox1.Value = "" Then
Soru = MsgBox("Textbox1'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı")
TextBox1.SetFocus
If Soru = vbYes Then GoTo devam
If Soru = vbNo Then Exit Sub
End If
devam:
If TextBox1.Value <> "" Then
Sheets("Sayfa1").Activate
....
...
..

 

[oerbas]

İstediğim gibi olmuş çok teşekkür ederim

 

[oerbas]

Bir husus daha var ben verileri aktif sayfaya değilde Girişler olarak isimlendirdiğim sayfaya kaydetmek istiyorum bunun için makroda ne gibi değişiklik yapmalıyım

 

[oerbas]

Veri girişlerini zorunlu hale getiren makroyu nereye kopyalamalıyım veri giriş zorunluluğu olmasını istediğim TextBox boş geçildiği zaman uyarmasını istiyorum

 

[oerbas]

Verileri istediğim sayfaya aktarmayı sağlayabildim mesajımı dikkate almayınız.

 

[xxrt]

aktif sayfaya değilde Girişler

Bunun İçin

Private Sub CommandButton1_Click() 
If TextBox1.Value <> "" Then 
Sheets("Sayfa1").Activate

Sayfa1'in ismini istediğiniz ismi yazın.

Sheets("Sayfa1").Activate

TextBox boş geçildiği zaman uyarmasını istiyorum.

Bunun için textBox1 örnek vermiştim..

Private Sub CommandButton1_Click() 
'TextBox1 veri girmemesi halinde ikaz 
If TextBox1.Value = "" Then 
Soru = MsgBox("Textbox1'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı") 
TextBox1.SetFocus 
If Soru = vbYes Then GoTo devam 
If Soru = vbNo Then Exit Sub 
End If 
'TextBox2 veri girmemesi halinde ikaz 
If TextBox2.Value = "" Then 
Soru = MsgBox("Textbox2'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı") 
TextBox2.SetFocus 
If Soru = vbYes Then GoTo devam 
If Soru = vbNo Then Exit Sub 
End If
'TextBox3 veri girmemesi halinde ikaz 
If TextBox3.Value = "" Then 
Soru = MsgBox("Textbox3'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı") 
TextBox3.SetFocus 
If Soru = vbYes Then GoTo devam 
If Soru = vbNo Then Exit Sub 
End If
'TextBox4 veri girmemesi halinde ikaz 
If TextBox4.Value = "" Then 
Soru = MsgBox("Textbox4'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı") 
TextBox4.SetFocus 
If Soru = vbYes Then GoTo devam 
If Soru = vbNo Then Exit Sub 
End If
devam:
If TextBox1.Value <> "" Then 
Sheets("Sayfa1").Activate 
Cells(3, 1).Select 
Do While ActiveCell.Value <> "" 
If Trim(ActiveCell.Value) = Trim(Me.TextBox1.Value) Then 
If MsgBox(Me.TextBox1 & " Sicil Numaralı İşçi Kaydı Vardır." & " Yeniden Kayıt Yapılsın mı?", vbYesNo, "Mükerrer Kayıt") = vbNo Then Exit Sub 
End If 
ActiveCell.Offset(1, 0).Activate 
Loop 
ActiveCell.Value = TextBox1.Value 
ActiveCell.Offset(0, 1).Value = TextBox2.Value 
ActiveCell.Offset(0, 2).Value = TextBox3.Value 
ActiveCell.Offset(0, 3).Value = TextBox4.Value 
End If 
TextBox1.Text = "" 
TextBox2.Text = "" 
TextBox3.Text = "" 
TextBox4.Text = "" 
End Sub

Olayın mantığı bu,bunu uzatabilirsin..

 

[oerbas]

Verdiğiniz bu faydalı bilgiler için teşekkürlerrrr xxrt.
Sağlıcakla kalınız

 

[isaatar]

verileri farklı sayfaya kayderken

Merhabalar sorum şu;
Ben oerbas' ın yaptığına ek olarak, verilerin sayfa2' ye kayderken
userformun aktiv sayfaya gitmesini istemiyorum.Yani kayıt işlerimi yapılırken sayfa2 gizli olacak.Bununla ilgili kodları yapamadım.
Yardımcı olursanız sevinirim...

 

[Levent Menteşoğlu]

Aşağıdaki satırları değiştirerek deneyin.

Kodlardaki bu satırları aşağıdaki gibi değiştirin

[vb:1:cce7d26124]Sheets("Sayfa1").Activate
Cells(3, 1).Select
[/vb:1:cce7d26124]

yerine konacak satır

[vb:1:cce7d26124]Sheets("Sayfa1").Activate[/vb:1:cce7d26124]

 

[Guest]

SELAMLAR;
VERİLEN KOD GAYET İYİ ÇALIÞIYOR. ANCAK BİR SORUNUM VAR.
VERİ KAYDI A3 HÜCRESİNDEN BAÞLIYOR. VERİ KAYIT BAÞLANGICINI C3 VEYA KISACA G SUTÜNUNDAN BAÞLATMAK İÇİN NE GİBİ DEÐİÞİKLİK YAPILMASI GEREKİR. TEÞEKKÜRLER

 

[Levent Menteşoğlu]

[vb:1:28eea02c4b]Cells(3, 1).Select
[/vb:1:28eea02c4b]
C3 hücresinden başlatmak için yukarıdaki satır yerine
[vb:1:28eea02c4b]Cells(3, 3).Select
[/vb:1:28eea02c4b]

G1 hücresi için ise

[vb:1:28eea02c4b]Cells(1, 7).Select
[/vb:1:28eea02c4b]

şeklinde değiştirin.

NOT: cells(x,y) nin yazılışı, hücrenin makroda tanımlanma şekillerinden biridir. Burada x:satır numarası, y:sütun numarasıdır. örneğin: cells(1,1) dediğinizde bu A1 hücresinin eş değer yazılışıdır.

 

[ekankim]

Bu kodu sorandan ve cevaplayandan allah bn kere razı olsun. N zamandan beri arıtordum böyle bir kodu. Daaha yeniyim hatta çok yeniyim. kendi çabalarımla biraz karmaşık olan ama çalışma şeklimi düzene sokacak bir çalışma yapmaktayım. Bu kod çok işime yaradı. Yalnız bir sorun var ben kayıttan sonra SELAM yazan mesaj kutusunun yerine VERİ KAYDEDİLMİŞTİR yazmasını istiyorum bunu nasıl yapacağım. Yardımcı olursanız sevinirim.

 

[dream_er]

Bu sorunun aynından bende sordum ama cevap gelmedi Herhalde biraz uzun sordumm. benm sorum Textboxlara girilen verilerin c2 hücresi boş olan ilk sayfaya yazılmasıydı kitap 20 sayfalık

 

[ERENYILMAZ]

Private Sub CommandButton1_Click()
'TextBox1 veri girmemesi halinde ikaz
If TextBox1.Value = "" Then
Soru = MsgBox("Textbox1'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı")
TextBox1.SetFocus
If Soru = vbYes Then GoTo devam
If Soru = vbNo Then Exit Sub
End If
'TextBox2 veri girmemesi halinde ikaz
If TextBox2.Value = "" Then
Soru = MsgBox("Textbox2'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı")
TextBox2.SetFocus
If Soru = vbYes Then GoTo devam
If Soru = vbNo Then Exit Sub
End If
'TextBox3 veri girmemesi halinde ikaz
If TextBox3.Value = "" Then
Soru = MsgBox("Textbox3'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı")
TextBox3.SetFocus
If Soru = vbYes Then GoTo devam
If Soru = vbNo Then Exit Sub
End If
'TextBox4 veri girmemesi halinde ikaz
If TextBox4.Value = "" Then
Soru = MsgBox("Textbox4'e Veri Girmemişsiniz.Devam edeyimmi", vbYesNo, "Soru Başlığı")
TextBox4.SetFocus
If Soru = vbYes Then GoTo devam
If Soru = vbNo Then Exit Sub
End If
devam:
If TextBox1.Value <> "" Then
Sheets("Sayfa1").Activate
Cells(3, 1).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.TextBox1.Value) Then
If MsgBox(Me.TextBox1 & " Sicil Numaralı İşçi Kaydı Vardır." & " Yeniden Kayıt Yapılsın mı?", vbYesNo, "Mükerrer Kayıt") = vbNo Then Exit Sub
End If
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Value = TextBox1.Value
ActiveCell.Offset(0, 1).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox3.Value
ActiveCell.Offset(0, 3).Value = TextBox4.Value
MsgBox "KAYIT İŞLEMİ YAPILMIŞTIR."
End If
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
End Sub

'MsgBox "KAYIT İŞLEMİ YAPILMIŞTIR." KODLARA YUKARIDAKİ GİBİ İLAVE EDİNİZ