ahmed eloony

حاضر اخى بارك الله فيك فى sheet (بحث) محتاج احافظ على داله voolkup او استبدالها بكود بحث ومحتاج كود تعديل عليها حتترحل بعد تعديلها ل sheet 1 من بدايه الخانه p16 وحفظها فى myfile = "H:\013\" & Sheet3.Range("c9") & "-""& Sheet3.Range("g9")".pdf" وكود لحذفها وكود لاعادتها من الحذف لو امكن دا بالنسبه لشيت (بحث) بالنسبه لشيت sheet1 محتاج احط فى كود الترحيل عدم التكرار و بحث وتعديل فى sheet 1 مش عايز اغير فيها حاجه دا بعد اذن حضرتك ومحتاج اعرف لو عندى معادله اذاى احطها فى اليوزر فورم او فى vpa وجزاك الله خيرا وجزاك فردوسا الاحدث.xlsm وياريت الشرح للى حتعمله عشان اتعلم من حضرتك ومتعبكش معايا بعد كدا بوركت اخى

]دى مشكله فى الحفظ

myfile = "h:\12\" & Sheet1.Range("d9") & "-" & Sheet1.Range("h9") & ".pdf" 'حفظ الفاتوره بصيغه pdf Sheet1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile مش عارف ايه المشكله فى الكود ده معلش حتعبكوا معايا معلش انا جديد فى الموقع وبكتب تعليقات وسعات مبلاقيهاش فممكن تلاقيها متكرره محتاج كود لعدم تكرار رقم الفاتوره وكود للتعديل وكود للحذف وكود لاعادتها بعد الحذف ودا حيكون على الاكواد دى حضرتك Sub OFFICNA() Dim LR2 As Long, ws As Worksheet Set ws = Sheets("Sheet1") LR2 = ws.Range("a" & Rows.Count).End(xlUp).Row If ws.Range("d11").Value = "" Then MsgBox ("من فضلك اكمل البيانات") Else ws.Range("a2:a2").Copy ws.Range("a" & LR2 + 1) ws.Select ws.Range("d9:d9").Copy ws.Range("p" & LR2 + 1) ws.Select ws.Range("d11:d11").Copy ws.Range("s" & LR2 + 1) ws.Select ws.Range("d12:d12").Copy ws.Range("am" & LR2 + 1) ws.Select ws.Range("h9:h9").Copy ws.Range("r" & LR2 + 1) ws.Select ws.Range("h11:h11").Copy ws.Range("q" & LR2 + 1) ws.Select ws.Range("d15:d15").Copy ws.Range("t" & LR2 + 1) ws.Select ws.Range("d16:d16").Copy ws.Range("x" & LR2 + 1) ws.Select ws.Range("d17:d17").Copy ws.Range("ab" & LR2 + 1) ws.Select ws.Range("d18:d18").Copy ws.Range("af" & LR2 + 1) ws.Select ws.Range("d19:d19").Copy ws.Range("aj" & LR2 + 1) ws.Select ws.Range("f15:f15").Copy ws.Range("u" & LR2 + 1) ws.Select ws.Range("f16:f16").Copy ws.Range("y" & LR2 + 1) ws.Select ws.Range("f17:f17").Copy ws.Range("ac" & LR2 + 1) ws.Select ws.Range("f18:f18").Copy ws.Range("ag" & LR2 + 1) ws.Select ws.Range("f19:f19").Copy ws.Range("ak" & LR2 + 1) ws.Select ws.Range("h15:h15").Copy ws.Range("v" & LR2 + 1) ws.Select ws.Range("h16:h16").Copy ws.Range("z" & LR2 + 1) ws.Select ws.Range("h17:h17").Copy ws.Range("ad" & LR2 + 1) ws.Select ws.Range("h18:h18").Copy ws.Range("ah" & LR2 + 1) ws.Select ws.Range("h19:h19").Copy ws.Range("al" & LR2 + 1) ws.Select اخر مشكله مشكله داله البحث لما بتستدعى بيانات فى الخانه لو انا عدلت عليها يعنى مثلا رقم 3 خليته انا 4 عشان اعدل عليها فالداله بتتمسح عايزلها حل وشكرا لتعب حضرتك معايا

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

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

السلام عليكم وبارك الله فيكم لو سمحتم عندى بعض الاسئله لو تكرمتم الاول اريد كود ترحيل ل row بعد p16 يكون p 17 الخ Selection.Copy Range("p16").Select ActiveSheet.Paste Application.CutCopyMode = False Range("d12").Select Selection.Copy Range("am16").Select ActiveSheet.Paste Application.CutCopyMode = False Range("D11").Select Selection.Copy Range("s16").Select ActiveSheet.Paste Range("H11").Select Application.CutCopyMode = False Selection.Copy Range("Q16").Select ActiveSheet.Paste Range("H9").Select Application.CutCopyMode = False Selection.Copy Range("R16").Select ActiveSheet.Paste Range("D15").Select Application.CutCopyMode = False Selection.Copy Range("T16").Select ActiveSheet.Paste Range("D16").Select Application.CutCopyMode = False Selection.Copy Range("X16").Select ActiveSheet.Paste Range("F15").Select Application.CutCopyMode = False Selection.Copy Range("U16").Select ActiveSheet.Paste Range("H15").Select Application.CutCopyMode = False Selection.Copy Range("V16").Select ActiveSheet.Paste Range("F16").Select Application.CutCopyMode = False Selection.Copy Range("Y16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=10 Range("H16").Select Application.CutCopyMode = False Selection.Copy Range("Z16").Select ActiveSheet.Paste Range("D17").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-3 Range("AB16").Select ActiveSheet.Paste Range("F17").Select Application.CutCopyMode = False Selection.Copy Range("AC16").Select ActiveSheet.Paste Range("H17").Select Application.CutCopyMode = False Selection.Copy Range("AD16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=5 Range("D18").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-9 Range("AF16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=4 Range("F18").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-4 Range("AG16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=4 Range("H18").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-9 Range("AH16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=14 Range("D19").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-13 Range("AJ16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=13 Range("F19").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-19 Range("AK16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=19 Range("H19").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll ToRight:=-19 Range("AL16").Select ActiveSheet.Paste ActiveWindow.SmallScroll ToRight:=19 Range("I38").Select Application.CutCopyMode = False Selection.Copy Range("J38").Select ActiveSheet.Paste Range("L27").Select If Sheet1.Range("d11").Value = "" Then MsgBox ("خطا فى ادخال البيانات") Else End If If Sheet1.Range("d9").Value = "" Then MsgBox ("خطا فى ادخال البيانات") Else End If If Sheet1.Range("d12").Value = "" Then MsgBox ("خطا فى ادخال البيانات") Else End If If Sheet1.Range("h11").Value = "" Then MsgBox ("خطا فى ادخال البيانات") Else End If If Sheet1.Range("h9").Value = "" Then MsgBox ("خطا فى ادخال البيانات") Else End If End Sub ثانيا كود لعدم الترحيل اذا كان فيه شى ناقص وليست رساله فقط انما تمنع بالفعل الترحيل وتمنع التكرار ايضا ثالثا انا بستخدم داله voolkup فى بحث عن الفاتوره عندما اريد التعديل عليها تحذف الداله اريد التعديل عليها وترحيلها مره اخرى وتبقى الداله موجوده تعمل رابعا بعد البحث عن فاتوره اريدها . الفاتوره رقمها حيكون موجود للبحث عنها فى خانه =Sheet1!C9 والجدول الموجود فيه الفاتوره حيكون فى شيت تانى بدايه الجدول =فاتوره!P15 وتنتهى =فاتوره!AO2060 واريد زر التعديل عليها واريد زر لاعادتها بعد الحذف و اريد زر لحذفها . ممكن حضرتك تعملى نموذج على البيانات دى وانا اكمله وجزاكم الله خيرا ونفع بكم واجزلكم بعطاءه