Şarta bağlı olarak birden fazla sayfaya veri aktarma

E

Erdinç FIRTINA

Altın Üye
Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
15-05-2026
Değerli üyeler,
Userform üzerinden excel sayfasına verileri aktarabiliyorum. Ancak, aktarmak istediğim verileri OPTİONBUTTON seçimine bağlı olarak verileri aynı anda iki sayfaya da aktarmak istiyorum. Kodları isteğime uygun olarak düzenlemeye çalıştım. Birinci sayfaya verileri aktarabildiğim halde ikinci sayfaya aktaramıyorum.
(OptionButton1 işaretliyse aynı verilerin aynı zamanda 2. sayfaya da aktarılmasını aksi takdirde sadece 1. sayfaya aktarmasını istiyorum.)

Yardımlarınız için şimdiden teşekkürler!!!

Private Sub CommandButton1_Click()
Sheets("ÖĞRENCİ_BİLGİLERİ_1").Select
Range("A1").Select
Range("A1") = "SIRA NO"
Range("B1") = "ADI SOYADI"
Range("C1") = "DOĞUM YERİ"
Range("D1") = "DOĞUM TARİHİ"
If TextBox1.Value = "" Then
MsgBox "VERİ GİRİNİZ"
Range("a1").Select
Unload Me
UserForm4.Show
Exit Sub
End If
For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))
Range("a" & sira + 1) = sira
Next
For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65536")))
If bak = TextBox1 Then
MsgBox "Bu isimde bir kaydınız mevcut"
Range("a1").Select

Unload Me
UserForm4.Show
Exit Sub
End If
Next
say = WorksheetFunction.CountA(Range("b1:b65536")) + 1

If OptionButton1.Value = True Then Range("E" & say) = "BAŞLADI"
If OptionButton2.Value = True Then Range("E" & say) = "BAŞLAMADI"
If OptionButton1.Value = False And OptionButton2.Value = False Then
MsgBox "Lütfen BAŞLAYIP BAŞLAMADIĞINI BELİRTİNİZ"

Exit Sub
End If
Range("B" & say) = TextBox1.Value
Range("C" & say) = TextBox2.Value
Range("D" & say) = TextBox3.Value
Range("E" & say) = TextBox4.Value

Columns("A:E").EntireColumn.AutoFit
Columns("B:E").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

If OptionButton1.Value = True Then

Sheets("ÖĞRENCİ_BİLGİLERİ_2").Select
Range("A1").Select
Range("a1") = "SIRA NO"
Range("A1") = "SIRA NO"
Range("B1") = "ADI SOYADI"
Range("C1") = "DOĞUM YERİ"
Range("D1") = "DOĞUM TARİHİ"
Exit Sub
End If

If TextBox1.Value = "" Then
MsgBox "VERİ GİRİNİZ"
Range("a1").Select
Unload Me
UserForm4.Show
Exit Sub
End If

For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))
Range("a" & sira + 1) = sira
Next
For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65536")))
If bak = TextBox1 Then
MsgBox "Bu isimde bir kaydınız mevcut"
Range("a1").Select
Unload Me
UserForm4.Show
Exit Sub
End If
Next
say = WorksheetFunction.CountA(Range("b1:b65536")) + 1
Range("B" & say) = TextBox1.Value
Range("C" & say) = TextBox2.Value
Range("D" & say) = TextBox3.Value
Range("E" & say) = TextBox4.Value

Columns("A:BE").EntireColumn.AutoFit
Columns("B:BE").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Sheets("ÖĞRENCİ_BİLGİLERİ_1").Select
Range("a1").Select
ActiveWorkbook.Save
' ActiveSheet.Protect "123"
Unload Me
UserForm4.Show
Exit Sub
End Sub
 
R

Recep İpek

Katılım
14 Şubat 2006
Mesajlar
3,426
Excel Vers. ve Dili
(Excel 2016 - İngilizce)
Altın Üyelik Bitiş Tarihi
30-11-2022
Kodlarınızı aşağıdaki şekilde değiştirerek deneyiniz.

Kod: 
Private Sub CommandButton1_Click()
Sheets("ÖĞRENCİ_BİLGİLERİ_1").Select
Range("A1").Select
Range("A1") = "SIRA NO"
Range("B1") = "ADI SOYADI"
Range("C1") = "DOĞUM YERİ"
Range("D1") = "DOĞUM TARİHİ"
If TextBox1.Value = "" Then
MsgBox "VERİ GİRİNİZ"
        Range("a1").Select
        Unload Me
        UserForm4.Show
Exit Sub
End If
For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))
Range("a" & sira + 1) = sira
Next
For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65536")))
If bak = TextBox1 Then
MsgBox "Bu isimde bir kaydınız mevcut"
        Range("a1").Select
        Unload Me
        UserForm4.Show
Exit Sub
End If
Next
say = WorksheetFunction.CountA(Range("b1:b65536")) + 1
If OptionButton1.Value = True Then Range("E" & say) = "BAŞLADI"
If OptionButton2.Value = True Then Range("E" & say) = "BAŞLAMADI"
If OptionButton1.Value = False And OptionButton2.Value = False Then
MsgBox "Lütfen BAŞLAYIP BAŞLAMADIĞINI BELİRTİNİZ"
Exit Sub
End If
Range("B" & say) = TextBox1.Value
Range("C" & say) = TextBox2.Value
Range("D" & say) = TextBox3.Value
Range("E" & say) = TextBox4.Value
Columns("A:E").EntireColumn.AutoFit
Columns("B:E").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
If OptionButton1.Value = True Then
Sheets("ÖĞRENCİ_BİLGİLERİ_2").Select
Range("A1").Select
For sira = 1 To WorksheetFunction.CountA(Range("b1:b65536"))
Range("a" & sira + 1) = sira
Next
For Each bak In Range("b1:b" & WorksheetFunction.CountA(Range("b1:b65536")))
If bak = TextBox1 Then
MsgBox "Bu isimde bir kaydınız mevcut"
        Range("a1").Select
        Unload Me
        UserForm4.Show
Exit Sub
End If
Next
say2 = WorksheetFunction.CountA(Range("b1:b65536")) + 1
Range("a1") = "SIRA NO"
Range("B1") = "ADI SOYADI"
Range("C1") = "DOĞUM YERİ"
Range("D1") = "DOĞUM TARİHİ"
Range("B" & say2) = TextBox1.Value
Range("C" & say2) = TextBox2.Value
Range("D" & say2) = TextBox3.Value
Range("E" & say2) = TextBox4.Value
End If
Sheets("ÖĞRENCİ_BİLGİLERİ_1").Select
        Range("a1").Select
        ActiveWorkbook.Save
'        ActiveSheet.Protect "123"
        Unload Me
        UserForm4.Show
End Sub
 
E

Erdinç FIRTINA

Altın Üye
Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
15-05-2026
Sayin Recep Rİpek,

Çok TeŞekkÜr Ederİm.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst