TextBox'lardan bir satır yapıp, Sayfa nın en son solu satırına kayıt yapmak.

[kelkitli]

Değerli Dostlar Selamlar,
Aşağıda yazılı makrodan Sayfadan Sayfaya veri kayıt yapabiliyorum.
Ancak UserForm1 de mevcut 25 adet textBox u aynı şekilde kullanamadım. Hatayı nerede yapıyorum.

Sub kayıt2()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sayfa1
Set S2 = Sayfa4
Set S3 = UserForm1
S3.Select
Range("TextBox1:TextBox25").Copy
S2.Select
Son_Satır = Range("B65536").End(3).Offset(1).Row
Range("A" & Son_Satır) = Son_Satır - 1
Range("B65536").End(3).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Application.CutCopyMode = False
S1.Select
Set S1 = Nothing
Set S2 = Nothing
Set S3 = Nothing
MsgBox "YAŞLI KAYIP KARTI KAYDI TAMAMLANDI"
End Sub

 

[Skorpiyon]

Sayın kelkitli,

1. Set S3 = Userform1 olarak ifade ettiğiniz Userform1 sayfa ismi mi ?
Değilse hemen altında kullandığınız S3.Select ifadesi hatalıdır.

2. Range("B65536").End(3).Offset(1).Select bu komut ile seçtiğiniz satıra bilgileri alt alta mı, yoksa yan yana mı yapıştırmak istiyorsunuz.

3. Aktif hücreyi bulduktan sonra, 25 adet textbox nesnesinin değerini yan yana yazdırmak için;

For a = 0 to 24
Activecell.offset(0,a).Value = Controls("Textbox" & a).Value
Next a

Alt alta yazdırmak için,
For a = 0 to 24
Activecell.offset(a,0).Value = Controls("Textbox" & a).Value
Next a

komutlarını kullanabilirsiniz.

 

[kelkitli]

Sayın Sertkaya cevap verdiğiniz içib teşekkür ederim. Kodları şu şekilde kullandım.

Sub kayıt2()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sayfa1
Set S2 = Sayfa4
UserForm1("TextBox1:TextBox25").Copy
S2.Select
Son_Satır = Range("B65536").End(3).Offset(1).Row
Range("A" & Son_Satır) = Son_Satır - 1
Range("B65536").End(3).Offset(1).Select
For a = 0 To 24
ActiveCell.Offset(0, a).Value = UserForm1.Controls("Textbox" & a).Value
Next a
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Application.CutCopyMode = False
S1.Select
Set S1 = Nothing
Set S2 = Nothing
MsgBox "YAŞLI KAYIP KARTI KAYDI TAMAMLANDI"
End Sub

Ancak "SIRA NO" dan sonra B sütunundan itibaren satıra yazması gerekirken, B sütununa ait hücreyi boş bırakıp, C sütunundan itibaren satıra yazıyor.

 

[kelkitli]

Sayın Sertkaya işlem tamam düzelttim. Sağol varol.

Sub kayıt2()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sayfa1
Set S2 = Sayfa4
UserForm1("TextBox1:TextBox25").Copy
S2.Select
Son_Satır = Range("B65536").End(3).Offset(1).Row
Range("A" & Son_Satır) = Son_Satır - 1
Range("B65536").End(3).Offset(1, -1).Select
For a = 0 To 24
ActiveCell.Offset(0, a).Value = UserForm1.Controls("Textbox" & a).Value
Next a
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Application.CutCopyMode = False
S1.Select
Set S1 = Nothing
Set S2 = Nothing
MsgBox "YAŞLI KAYIP KARTI KAYDI TAMAMLANDI"
End Sub

 

[Skorpiyon]

Aşağıda kırmızı ile belirtilen yeri silerek deneyin.

Range("B65536").End(3).Offset(1).Select

Yani;
Range("B65536").End(3).Select 'B sütunundaki en son dolu hücreyi seçer.

 

[Orion1]

Doğrusu bu.Aşağıdaki satırın eski satırla değiştirin.

Range("B65536").End(3).Offset(1).Select
For a = 0 To 24
ActiveCell.Offset(0, a).Value = UserForm1.Controls("Textbox" & a[B][COLOR="Red"]+1[/COLOR][/B]).Value
Next a

 

[kelkitli]

Teşekkür ederim Sayın Evren Bey.

 

[Orion1]

Teşekkür ederim Sayın Evren Bey.

Rica ederim.
iyi çalışmalar.