تعديل كود ترحيل

[أبو عبد الملك السوفي]

السلام عليكم اسات\تنا الكرام

هذا الكود من احد اساتذة المنتى جزاه الله خيرا

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

Sub Tarheel()
'ÞÑÇÁÉ ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí
Dim d(17)
d(1) = [g2]: d(2) = [g3]: d(3) = [g4]: d(4) = [b8]: d(5) = [g8]: d(6) = [c13]: d(7) = [f13]: d(8) = [c18]: d(9) = [f19]: d(10) = [c20]: d(11) = [b23]: d(12) = [b26]: d(13) = [c26]: d(14) = [b27]: d(15) = [c27]: d(16) = [b28]: d(17) = [c28]

'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ
With Sheets("total")
    LR = .[a10000].End(xlUp).Row
        For r = 1 To LR
            x = .Cells(r, 1).Value
            If x = [v6] Then GoTo 20     ' *** Found @ r (Row)***
        Next r
    GoTo 10                              ' NOT Found

10
        MsgBox ("ÇáÝÇÊæÑÉ ãæÌæÏÉ ãä ÞÈá" & Chr(10) & "ÓíÊã ÍÐÝåÇ ãä æÑÞÉ ÇáÈíÇäÇÊ æäÞáåÇ Åáí ÂÎÑ ÇáæÑÞÉ")
        If r <> LR Then n_LR = .Cells(r, 2).End(xlDown).Row - 1: GoTo 20
            n_LR = .[i10000].End(xlUp).Row
20          .Range("a" & r & ":u" & n_LR).EntireRow.Delete Shift:=xlUp
             
30
'äÞá ÇáÈíÇäÇÊ ÇáÎãÓÉ ÇáÃæáí ááæÑÞÉ ÏÇÊÇ

DR = .[b10000].End(xlUp).Row + 1         'ÂÎÑ ÕÝ ÈíÇäÇÊ ÌÇåÒ áÇÓÊáÇã ÈíÇäÇÊ ÌÏíÏÉ ÈÇáæÑÞÉ ÏÇÊÇ
    For i = 1 To 17
        .Cells(DR, i + 1) = d(i)
    Next i
End With

LR = [E30].End(xlUp).Row

Sheets("mokalassa").Select
Reply = MsgBox("Êã ÊÑÍíá ÇáÝÇÊæÑÉ ÈÍãÏ Çááå" & Chr(10) & "åá ÊÑíÏ ãÓÍ ÇáÈíÇäÇÊ ãäåÇ", vbYesNo)
If Reply <> 6 Then Exit Sub
Range("G2").ClearContents
Range("G3").ClearContents
Range("G4").ClearContents
Range("b8:e8").ClearContents
Range("g8").ClearContents
Range("c13:d13").ClearContents
Range("f13:g13").ClearContents
Range("c18:d18").ClearContents
Range("f19:g19").ClearContents
Range("c20:d20").ClearContents
Range("b23:c23").ClearContents
[g6] = [g6] + 1
Range("b26:b28").ClearContents
Range("c26:g26").ClearContents
Range("c27:g27").ClearContents
Range("c28:g28").ClearContents

End Sub

ولا ينقلها الى اخر سطر

برنامج المخالصة2017.rar

[أبو عبد الملك السوفي]

هذا مرفق به مثال

برنامج المخالصة2017_2.rar

[أبو عبد الملك السوفي]

للرقع

[أبو عبد الملك السوفي]

للرفع جزاكم الله

 

[أبو عبد الملك السوفي]

للرفع رفع الله مقامكم