اضف هذ السطر في نهاية كود الترحيل
Range("C9:F28,c7,c6").ClearContents
ليصبح
Sub Tarhil_salim1()
Dim lrb, lrg, My_Max, Name_count, Date_count As Integer
Dim S_Sh As Worksheet
Dim T_Sh As Worksheet
Set S_Sh = Sheets("الفاتورة"): Set T_Sh = Sheets("الارشيف")
Name_count = Application.CountIf(T_Sh.Range("A:A"), S_Sh.Range("c5"))
'Date_count = Application.CountIf(T_Sh.Range("b:b"), S_Sh.Range("c6"))
If Name_count >= 1 Then
Message = MsgBox("هذه الفاتورة يمكن ان تكون مكررة! تأكد من ذلك" & Chr(10) & "اذا أردت الاستمرار إضغط نعم", 68)
If Message <> 6 Then Exit Sub
End If
My_Max = Application.Max(S_Sh.Range("b9:b28"))
lrg = T_Sh.Cells(Rows.Count, "G").End(3).Row
If lrg = 1 Then lrg = 2
If lrg = 2 Then
S_Sh.Range("c9" & ":f" & 9 + My_Max - 1).Copy Destination:=T_Sh.Range("g" & lrg)
Else
S_Sh.Range("c9" & ":f" & 9 + My_Max - 1).Copy Destination:=T_Sh.Range("g" & lrg + 2)
End If
T_Sh.Range("H:j").Value = T_Sh.Range("H:j").Value
lrg = T_Sh.Cells(Rows.Count, "G").End(3).Row
lrb = lrg - My_Max + 1
With T_Sh
.Cells(lrb, 1) = S_Sh.Range("c5").Value
.Cells(lrb, 2) = S_Sh.Range("c6").Value
.Cells(lrb, 3) = S_Sh.Range("c7").Value
.Cells(lrb, 4) = S_Sh.Range("c38").Value
.Cells(lrb, 5) = S_Sh.Range("c39").Value
.Cells(lrb, 6) = S_Sh.Range("c36").Value
Range("C9:F28,c7,c6").ClearContents
End With
End Sub