كود ترحيل من نموذج إدخال الى صفحة أخرى

[esam1983]

السلام عليكم ورحمة الله وبركاته

بحاول اعمل ترحيل بيانات اكسيل 

وبتظهر لي خطأ run time error 424

وده فايل الملف مرة تانية .... وشكرا مقدما لحضرتك 

من فضلك لا تقوم مرة أخرى بدمج ورفع مشاركتك مع مشاركة قديمة , تـــم فصل مشاركتك بمشاركة جديدة ومستقلة

فايز.xlsm

[سليم حاصبيا]

الكود اللازم مع التنسيق بعد الترحيل

Option Explicit
Dim Source As Worksheet
Dim Target As Worksheet
Dim Mx%, i%, rO%
Dim Ar_S
Dim Ar_T
'++++++++++++++++++++++++++++++++++++++++++++
Sub Fayez()
Set Source = Sheets("sheet1")
Set Target = Sheets("sheet2")

Mx = Target.Cells(Rows.Count, 2).End(3).Row + 1
Ar_S = Array("D7", "D9", "D11", "G7", "G9", "G11", "G13")
Ar_T = Array("B", "C", "D", "E", "F", "G", "H")
  For i = LBound(Ar_S) To UBound(Ar_S)
    Target.Cells(Mx, Ar_T(i)) = Source.Range(Ar_S(i))
   Source.Range(Ar_S(i)) = vbNullString
  Next
'هذا السطر لحذف البيانات المكررة اذا لا تريده يمكنك حذفه
'+++++++++++++++++++++++++++++++++++++++
Target.Range("A1:H" & Mx).RemoveDuplicates _
Columns:=Array(1, 2, 2, 2, 5, 6, 7), Header:=1
'++++++++++++++++++++++++++++++++++++++++
rO = Target.Range("b2").CurrentRegion.Rows.Count
 If rO > 1 Then
  With Target.Range("b2").CurrentRegion. _
     Offset(1).Resize(rO - 1)
    .HorizontalAlignment = 1
   .Borders.LineStyle = 1
   .InsertIndent 1
   .Font.Bold = True
   .Font.Size = 16
   .Cells(1, 1).Resize(rO - 1).Value = _
    Evaluate("row(1:" & rO - 1 & ")")
   
 End With
 End If
End Sub

الملف مرفق

esam1983.xlsm

[esam1983]

شكرا لكم وجزاكم الله كل خير على الاهتمام 

ربي يوفقكم جميعا

[أحمد يوسف]

esam1983

أين انت من  هذه الإجابة الممتازة؟!!! لم أرى اى ضغط على الإعجاب من طرفك , وهل جزاء الإحسان الا الإحسان ؟!!!!

أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!! 💙