isime göre yeni çalışma sayfası açma

[sinemomec]

userform üzerinden veri girişi yapıp sayfa1 de verilerimi kaydediyorum ve her yeni veri en son satıra kaydediyor. ben yeni veri girişi kaydettiğim (isim soyisim) zaman adına yeni çalışma kitabının içine yeni çalışma sayfasını açmasını istiyorum.

Dim sonsatır, listele

Private Sub CommandButton1_Click()

If TextBox1.Text = "" Then
MsgBox "İSİM-SOYİSİM BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf TextBox2.Text = "" Then
MsgBox "TC NO BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub
ElseIf TextBox4.Text = "" Then
MsgBox "ADRES BOŞ OLAMAZ.", vbInformation, "BİLDİRİ"
Exit Sub


End If
sonsatır = Worksheets("sayfa1").Cells(Rows.Count, "A").End(xlUp).Row + 1



say = WorksheetFunction.CountIf(Worksheets("sayfa1").Range("C:C"), TextBox2.Value)
If say > 0 Then
    MsgBox TextBox2.Value & " ÖNCEDEN KAYDI YAPILMIŞTIR!", vbExclamation, ""
    Exit Sub
End If


say = WorksheetFunction.CountIf(Worksheets("sayfa1").Range("C:C"), TextBox2.Value)
If say > 0 Then Exit Sub



If sonsatır = 2 Then
Worksheets("sayfa1").Cells(sonsatır, 1) = 1
Else
Worksheets("sayfa1").Cells(sonsatır, 1) = Worksheets("sayfa1").Cells(sonsatır - 1, 1) + 1
End If
Worksheets("sayfa1").Cells(sonsatır, 2) = TextBox1.Value
Worksheets("sayfa1").Cells(sonsatır, 3) = TextBox2.Value
Worksheets("sayfa1").Cells(sonsatır, 4) = TextBox3.Value
Worksheets("sayfa1").Cells(sonsatır, 5) = TextBox4.Value

MsgBox "VERİ KAYDEDİLDİ.", vbInformation, "BİLDİRİ"

TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""


Sheets.Add After:=Sheets(Sheets.Count) ' TOPLAM SAYFA SAYISI
Dim WS As Worksheet
Set WS = Sheets.Add

son = Cells(Rows.Count, "B").End(xlUp).Row

WS.Name = Cells(son, 1)


End Sub


Private Sub worksheet_change(ByVal target As Range)
If Intersect([B:B], target) Is Nothing Then Exit Sub
Dim WS As Worksheet
Set WS = Sheets.Add

son = Cells(Rows.Count, "B").End(xlUp).Row

WS.Name = Cells(son, 1)

End Sub



Private Sub TextBox1_Change()
If TextBox1 = "" Then Exit Sub
deg = Mid(TextBox1.Value, Len(TextBox1.Value), 1)
If IsNumeric(deg) = True Then
MsgBox "SADECE HARF GİRİNİZ", vbInformation, "UYARI"
TextBox1 = Mid(TextBox1.Value, 1, Len(TextBox1.Value) - 1)
TextBox1.SetFocus
End If
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
   If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0: MsgBox "SADECE RAKAM GİRİNİZ!", vbInformation, "UYARI"
   TextBox2.MaxLength = 11
End Sub

 

[sinemomec]

Excel’de makro kullanarak otomatik olarak yeni sayfa ekleyebilirsiniz. Aşağıdaki kod B sütununa yeni eklenen bir verinin ismi ile yeni bir sayfa oluşturmaktadır. Farklı projelerde kullanılabilir. Kodu işlem yapacağınız sayfanın, sayfa koduna yapıştırmanız yeterlidir.



Private Sub worksheet_change(ByVal target As Range)
If Intersect([B:B], target) Is Nothing Then Exit Sub
Dim WS As Worksheet
Set WS = Sheets.Add

son = Cells(Rows.Count, "B").End(xlUp).Row

WS.Name = Cells(son, 1)

End Sub


bu kodu denedim ama sonuç alamadım hatayı nerde yaptım acaba...

 

[dEdE]

WS.Name = Cells(son, 1)

Yukarıdaki satırı şununla ActiveSheet.Name = Cells(son, 2) değiştirip dener misiniz?[/ICODE]

Not: Yeni konu için yeni başlık açmalısınız.

 

[sinemomec]

sonuç alamadım.

 

[dEdE]

sonuç alamadım.

Örnek dosya ekler misiniz?

 

[sinemomec]

İndir Yeni Microsoft Excel Çalışma Sayfası

Dosyayı indir Yeni Microsoft Excel Çalışma Sayfası

dosya.co

 

[dEdE]

Aşağıdaki kodu Sayfa1'in kod bölümüne yapıştırarak dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS As Worksheet
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
    Set WS = Sheets.Add
    son = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveSheet.Name = Cells(son, 2)
End Sub

 

[sinemomec]

tamamdır çalıştı ancak ben sayfa 1 hep en başta durmasını istiyorum. elinize sağlık teşekür ederim.

 

[dEdE]

tamamdır çalıştı ancak ben sayfa 1 hep en başta durmasını istiyorum. elinize sağlık teşekür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
    Sheets.Add After:=Sheets("Sayfa1")
    son = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveSheet.Name = Cells(son, 2)
End Sub