تم بحمد الله التوصل الى النتيجة المطلوبة فى كود التعديل
عن طريق كود ايضا للرائع الاستاذ : ابو حنين
والفكرة هى حذف البيانات القديمة عند التعديل واعادة ترحيل البيانات مرة اخرى
Sub sSave()
Application.ScreenUpdating = False
Dim i As Long, Last As Long, Sh As Worksheet, Shh As Worksheet
Set Sh = Sheets("main"): Set Shh = Sheets("database")
If Sh.Range("A6") = "" Then
MsgBox "لا توجد أي بيانات للترحيل", vbExclamation + vbMsgBoxRight, "خطأ"
Exit Sub: End If
LR = Sheets("database").[B1000000].End(xlUp).Row
For i = LR To 4 Step -1
If Sheets("database").Cells(i, 1) = Sheets("main").Range("C2") Then
Sheets("database").Rows(i).Delete Shift:=xlUp
End If
Next
'كود الترحيل أ:ابو حنين
If MsgBox("هل تريد ترحيل البيانات الحالية الى قاعدة البيانات", vbInformation + vbMsgBoxRight + vbYesNo, "ترحيل") = vbNo Then Exit Sub
x = Shh.Cells(Rows.Count, "B").End(xlUp).Row + 1
Last = Sh.Cells(Rows.Count, "A").End(xlUp).Row
For i = 6 To Last
Sh.Range("A" & i).Resize(, 8).Copy
With Shh
.Range("B" & x).PasteSpecial xlPasteValues: .Range("A" & x) = Sh.Range("C2").Value
.Range("A" & x & ":" & "I" & x).Borders.Value = 1: .Range("J" & x) = x - 4
x = x + 1
End With: Next
Sh.Range("A6:I" & Sh.Cells(Rows.Count, "A").End(xlUp).Row + 1).ClearContents: Sh.Range("C2") = ""
Application.ScreenUpdating = True
MsgBox "تم ترحيل البيانات بنجاح", vbInformation + vbMsgBoxRight, "ترحيل"
End Sub