Soru Makro ile dolu satırları başka sayfaya çekmek

[brkbkl]

Arkadaşlar merhaba üretimden malzeme siparişlerini mail ile almak için bir excel sayfası yapmak istiyorum.

Malzeme sayısı birden fazla olduğu durumlarda ne gibi bir kod kullanabilirim yardımcı olabilir misiniz?

Normalde bu kodları başka bir formda üretimdeki arızaları arşivlemek için kullanıyorum ve sorunsuz çalışıyor ama alt alta satır sayısı fazla olduğu zaman bunları arşivlemede sıkıntı yaşıyorum.

Ne gibi değişiklikler yapmam lazım. Verileri sürekli arşivlemesini istiyorum, basit bir örnek verirseniz gerisini uyarlayabileceğimi düşünüyorum.

Örnek bir dosya da bırakayım https://www.dosya.tc/server28/ot5l9c/Malzeme_Talep_Formu.xlsm.html buraya direkt nasıl dosya yükleniyor bilmediğim için böyle paylaştım.

Sub Arıza()
ActiveWorkbook.Save
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 = "com.tr"
.Cc = "com.tr"
.Subject = "Arıza Bildirim Formu"
.Body = "Merhaba, Arıza tespiti yapılmıştır gerekli bilgiler ekte mevcuttur."
.Attachments.Add ActiveWorkbook.FullName
    Sheets("ARŞİV").Select
    ActiveSheet.Unprotect Password:="123456"
    Sheets("FORM").Select
    Range("B3").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("A" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
    Range("B5").Select
    Selection.Copy
    Sheets("ARŞİV").Select
    Range("B" & SonSatır).Select
    ActiveSheet.Paste
    Sheets("FORM").Select
ActiveWorkbook.Save
.Send
MsgBox "Mail Gönderilmiştir."
Range("B3,B5").Select
Selection.ClearContents
Sheets("ARŞİV").Select
ActiveSheet.Protect Password:="123456"
Sheets("FORM").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub