AYNI MAKROYLA BÃRDEN ÇOK SAYFAYA KAYIT YAPMAK
Onayla dediğim zaman TextBoxlara girdiğim bilgilere gire bazı TextBoxlardaki bilgilerin Kasa sayfasına Bazı TaxtBoxlardaki bilgilerinde Carı Kart Sayfasına aktarılmasını istiyorum. Bu işlemi iki Ayrı komutla yapabiliyorum ama işi daha kolaylaştırmak istiyorum.
Bunun için aşağıdaki Makroyu yazdım ama hata veriyor yardımlarınızı bekliyorum.
Tüm Form çalışanlarına saygılarımla
Onayla dediğim zaman TextBoxlara girdiğim bilgilere gire bazı TextBoxlardaki bilgilerin Kasa sayfasına Bazı TaxtBoxlardaki bilgilerinde Carı Kart Sayfasına aktarılmasını istiyorum. Bu işlemi iki Ayrı komutla yapabiliyorum ama işi daha kolaylaştırmak istiyorum.
Bunun için aşağıdaki Makroyu yazdım ama hata veriyor yardımlarınızı bekliyorum.
Tüm Form çalışanlarına saygılarımla
Kod:
Private Sub CommandButton6_Click()
'Kasa defteri kayıtları başlıyor
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
'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("Stok Listesi").Activate
Cells(3, 1).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.TextBox15.Value) Then
If MsgBox(Me.TextBox15 & " Dosya Numaralı Ürün Kaydı Var" & " 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
ActiveCell.Offset(0, 4).Value = TextBox5.Value
ActiveCell.Offset(0, 5).Value = TextBox6.Value
ActiveCell.Offset(0, 6).Value = TextBox7.Value
ActiveCell.Offset(0, 7).Value = TextBox8.Value
ActiveCell.Offset(0, 8).Value = TextBox9.Value
ActiveCell.Offset(0, 9).Value = TextBox10.Value
ActiveCell.Offset(0, 10).Value = TextBox11.Value
End If
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
End Sub