Makro ile bir alta kayıt ettirme yardım

[byenerji]

arkadaşlar merhaba.
örnek kotlardan bir tane kod buldum fakat kot hep a5 hüçresine yapıştırıyor.
ben her sefer 1 altına yapıştırmassını istiyorum
bana yardımcı olursanız sevinirim.

Private Sub CommandButton1_Click()
Range("a5").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Ofset(1, 0).Select
Loop
If Range("a5").Value = "" Then
Range("a5").Value = 1
Range("a5").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
ActiveCell.Offset(0, 1).Value = TextBox1.Text
ActiveCell.Offset(0, 2).Value = TextBox2.Text
ActiveCell.Offset(0, 3).Value = TextBox3.Text
ActiveCell.Offset(0, 4).Value = TextBox4.Text
ActiveCell.Offset(0, 5).Value = TextBox5.Text
ActiveCell.Offset(0, 7).Value = TextBox6.Text
ActiveCell.Offset(0, 8).Value = TextBox7.Text
ActiveCell.Offset(0, 9).Value = TextBox8.Text
ActiveCell.Offset(0, 10).Value = TextBox9.Text
ActiveCell.Offset(0, 11).Value = TextBox10.Text
ActiveCell.Offset(0, 12).Value = TextBox11.Text
ActiveCell.Offset(0, 13).Value = TextBox12.Text

 

[İhsan Tank]

Dosya ekler misiniz_?

 

[byenerji]

dosyayı ekledim.
yardımcı olurmusunuz.
tarih secimini hakkında bilginiz varmı , daha başka nasıl yapabilirim.

 

[İhsan Tank]

dosyayı ekledim.
yardımcı olurmusunuz.
tarih secimini hakkında bilginiz varmı , daha başka nasıl yapabilirim.

Merhaba
Kodu bununla değiştirip dener misiniz_?

Private Sub CommandButton1_Click()
Dim ts
ts = Range("B" & Rows.Count).End(xlUp).Row
If ts < 5 Then
Range("A5").Select
Else
Range("A" & ts + 1).Select
End If
ActiveCell.Offset(0, 1).Value = TextBox1.Text
ActiveCell.Offset(0, 2).Value = TextBox2.Text
ActiveCell.Offset(0, 3).Value = TextBox3.Text
ActiveCell.Offset(0, 4).Value = TextBox4.Text
ActiveCell.Offset(0, 5).Value = TextBox5.Text
ActiveCell.Offset(0, 7).Value = TextBox6.Text
ActiveCell.Offset(0, 8).Value = TextBox7.Text
ActiveCell.Offset(0, 9).Value = TextBox8.Text
ActiveCell.Offset(0, 10).Value = TextBox9.Text
ActiveCell.Offset(0, 11).Value = TextBox10.Text
ActiveCell.Offset(0, 12).Value = TextBox11.Text
ActiveCell.Offset(0, 13).Value = TextBox12.Text
ActiveCell.Offset(0, 14).Value = TextBox13.Text
ActiveCell.Offset(0, 15).Value = TextBox14.Text
ActiveCell.Offset(0, 16).Value = TextBox15.Text
ActiveCell.Offset(0, 19).Value = TextBox16.Text
ActiveCell.Offset(0, 20).Value = TextBox17.Text
ActiveCell.Offset(0, 21).Value = TextBox18.Text
ActiveCell.Offset(0, 22).Value = TextBox19.Text
ActiveCell.Offset(0, 23).Value = TextBox20.Text
ActiveCell.Offset(0, 24).Value = TextBox21.Text
ActiveCell.Offset(0, 25).Value = TextBox22.Text
ActiveCell.Offset(0, 26).Value = TextBox23.Text
ActiveCell.Offset(0, 27).Value = TextBox24.Text
ActiveCell.Offset(0, 30).Value = TextBox25.Text
ActiveCell.Offset(0, 31).Value = TextBox26.Text
ActiveCell.Offset(0, 32).Value = TextBox27.Text
ActiveCell.Offset(0, 33).Value = TextBox28.Text
ActiveCell.Offset(0, 34).Value = TextBox29.Text
ActiveCell.Offset(0, 35).Value = TextBox30.Text
ActiveCell.Offset(0, 36).Value = TextBox31.Text
ActiveCell.Offset(0, 37).Value = TextBox32.Text

acik = "İşlem tamam"
buton = vbOKOnly + vbInformation + vbDefaultButton1
bas = Kayıt = "İşlemi"
MsgBox acik, buton, bas

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox13.Text = ""
TextBox14.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox19.Text = ""
TextBox20.Text = ""
TextBox21.Text = ""
TextBox22.Text = ""
TextBox23.Text = ""
TextBox24.Text = ""
TextBox25.Text = ""
TextBox26.Text = ""
TextBox27.Text = ""
TextBox28.Text = ""
TextBox29.Text = ""
TextBox30.Text = ""
TextBox31.Text = ""
TextBox32.Text = ""
End Sub

 

[byenerji]

çok teşekkür ederim

 

[İhsan Tank]

çok teşekkür ederim

Rica ederim
:keyif: