Makro ile aktarma

[stres]

Merhaba arkadaşlar

Private Sub CommandButton1_Click()
Range("A7").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("A7").Value = "" Then
Range("A7").Value = 1
Range("A7").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
ActiveCell.Offset(0, 5).Value = TextBox1.Text
ActiveCell.Offset(0, 8).Value = TextBox2.Text
ActiveCell.Offset(0, 11).Value = TextBox3.Text
ActiveCell.Offset(0, 30).Value = TextBox4.Text
ActiveCell.Offset(0, 4).Value = TextBox5.Text

açıklama = "Kayıt Yapıldı"
buton = vbOKOnly + vbInformation + vbdefaultbuttun1
başlık = "Elden Makbuz"
MsgBox açıklama, buto, başlık
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
End Sub

Bu kodlarla kaydet butonuna tıkladığımda sayfa 1de ilgili yerlere istediğim verilerin girişini yapabiliriyorum.Benim yapmak istediğim ise şu.Sayfa bire yapmış olduğum bu verileri sayfa2 de sırasıyla mesela (a1, a5, a9, a15 , a20)ye aktarsın .Aynı sayfa1 deki gibi her kaydedişte bir alt satırdan devam ediyorken sayfa 2 ye aktardığında da aynı işlemi yapsın bir alt satıra kopyalasın.Kısaca sayfa1 e girdiğim verileri sayfa2 ye kopyalamak istiyorum
Teşekkür ederim

 

[Skorpiyon]

Sayın stres,

Aşağıdaki kırmızı satırları kodlarınıza ekleyerek deneyiniz.

Private Sub CommandButton1_Click()
Range("A7").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("A7").Value = "" Then
Range("A7").Value = 1
Range("A7").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
ActiveCell.Offset(0, 5).Value = TextBox1.Text
ActiveCell.Offset(0, 8).Value = TextBox2.Text
ActiveCell.Offset(0, 11).Value = TextBox3.Text
ActiveCell.Offset(0, 30).Value = TextBox4.Text
ActiveCell.Offset(0, 4).Value = TextBox5.Text

Sheets("Sayfa2").[A65536].End(xlup).offset(1,0) = Textbox1.text 'A1 için
Sheets("Sayfa2").[A65536].End(xlup).offset(1,4) = Textbox2.text 'A5 için
Sheets("Sayfa2").[A65536].End(xlup).offset(1,8) = Textbox3.text 'A9 için
Sheets("Sayfa2").[A65536].End(xlup).offset(1,14) = Textbox4.text 'A15 için
Sheets("Sayfa2").[A65536].End(xlup).offset(1,19) = Textbox5.text 'A20 için

açıklama = "Kayıt Yapıldı"
buton = vbOKOnly + vbInformation + vbdefaultbuttun1
başlık = "Elden Makbuz"
MsgBox açıklama, buto, başlık
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
End Sub

 

[stres]

Teşekkürler şaban bey eline sağlık.