Yeni veri girişi olduğunda alt satıra geçmek

[brkbkl]

Arkadaşlar merhaba,
Hatalı imalatın bildirimi için bi makro kullanıyorum.
Veri girişi yapıldıktan sonra bana mail ile veriler geliyor fakat ben bunları kayıt altında tutmak istiyorum.
Veri girişi yapılınca yan sayfaya verileri kaydediyorum fakat her yeni veri girişinde bir alt satıra eklemesini istiyorum.
Benim kullandığım kodlarda sürekli aynı satırda aynı verinin üzerine yazıyor.
Bunu nasıl çözebilirim.
Şimdiden teşekkürler.

Sub Hatalı_imalat()

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "mail"
.Cc = "mail"
.Subject = "Hatalı İmalat Formu"
.Body = "Merhaba, Hatalı bir imalat bulunmaktadır."
.Attachments.Add ActiveWorkbook.FullName
ActiveWorkbook.Save
.Send
    Range("D6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("FORM").Select
    Range("G6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("B3").Select
    ActiveSheet.Paste
    Sheets("FORM").Select
Range("D6:F7,G6:I7,D8:I16,D17:I21,D24:F26,G24:I26").Select
Range("G24").Activate
Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[muratboz06]

Sub Hatalı_imalat()
SonSatır = Sheets("ARŞİV").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "mail"
.Cc = "mail"
.Subject = "Hatalı İmalat Formu"
.Body = "Merhaba, Hatalı bir imalat bulunmaktadır."
.Attachments.Add ActiveWorkbook.FullName
ActiveWorkbook.Save
.Send
    Range("D6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("A" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
    Range("G6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("B" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
Range("D6:F7,G6:I7,D8:I16,D17:I21,D24:F26,G24:I26").Select
Range("G24").Activate
Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[brkbkl]

Sub Hatalı_imalat()
SonSatır = Sheets("ARŞİV").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "mail"
.Cc = "mail"
.Subject = "Hatalı İmalat Formu"
.Body = "Merhaba, Hatalı bir imalat bulunmaktadır."
.Attachments.Add ActiveWorkbook.FullName
ActiveWorkbook.Save
.Send
    Range("D6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("A" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
    Range("G6").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("B" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
Range("D6:F7,G6:I7,D8:I16,D17:I21,D24:F26,G24:I26").Select
Range("G24").Activate
Selection.ClearContents
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Çok teşekkür ederim çalıştı.