عند ادراج صف جديد نسخ معادلة VLOOKUP الى الصف المدرج الجديد

[فوزى فوزى]

بعد البحث فى المنتدى وجدت هذا الشيت لاستاذ عادل حنفى ولكن اريد اضافة على الكود ان ينسخ المعادلة الى الاسفل متمنين لكم التوفيق والسداد 

اجمالي نزول الى الاسفل.xls

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

ربما هذا الكود يفي بالغرض

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 1 And Target.Count = 1 And _
Application.CountIf(Range("salim_rg"), Target) <> 0 And Target.Offset(1) = "Total" Then

ADD_rows (Target.Row)

With Target.Offset(2, 1)
.Formula = "=sum(B3:B" & Target.Row & ")"
.Offset(, 1).Formula = "=sum(C3:C" & Target.Row & ")"
.Offset(, 2).Formula = "=sum(D3:D" & Target.Row & ")"
End With
End If
Application.EnableEvents = True
End Sub

'+++++++++++++++++++++++++++++++++++++++++
Sub ADD_rows(n%)
Dim MyRows As Integer

MyRows = Range("A3").CurrentRegion.Rows.Count + 2
Rows(n + 1).Insert Shift:=xlDown
Cells(n, 1).Offset(, 1).Resize(, 3).Formula = _
"=VLOOKUP($A" & n & ",salim_rg,COLUMNS($A$1:A1)+1,0)"

End Sub

الملف للمعاينة مرفق

Auto_Load.xlsm

[فوزى فوزى]

ربنا يجزيك خير استاذ سليم هذا هو المطلوب فيه نقطة عند حذف الصفوف واعادة كتابة الاسماء مرة اخرى الكود لايعمل والعمل القائم على التعبئة والحذف ارجو مرعاة هذه النقطة وشكرا على مجهودك وربنا يبارك فيكم وفى علمكم