أيهاب ممدوح

اخي الكريم مطلوب ترحيل كامل الصف للمستأجر مع اسم الصفحه او خلايا معينه مثل رقم الشقه تاريخ الانتهاء وعدد ايام التأخير والايجار ورقم الجوال Sub RentLate() Dim c As Range Dim ws As Worksheet, Sh As Worksheet Dim p As Long p = 5 Set ws = Sheets("المتأخرين") For Each Sh In Worksheets If Sh.Name <> "المتأخرين" Then For Each c In Sh.Range("D6:D" & Sh.Range("D" & Rows.Count).End(xlUp).Row) If c.Value > 0 And c.Value < 1000 Then p = p + 1 ws.Cells(p, 1) = p - 5 ws.Cells(p, 2) = c.Offset(0, 12) ws.Cells(p, 3) = c.Worksheet.Name End If Next End If Next End Sub

اخي الكريم شكرا علي مجهودك لكن الكود يقوم بترحيل الغير متأخرين ( المتأخرين يتم تحديدهم عن طريق العمود d الذي به عدد ايام التأخير ) ويقوم بجلب كل الصف وليس الاسم فقط

مطلوب ترحيل كل المستأجرين المتأخرين في كل الصفحات الي صفحه واحده ويكتب جنب كل مستأجر اسم الصفحه التي تم ترحيله منها حتي يتم معرفه اسم المستأجر واسم العمارة وشكرا الايجارات (2).xlsm

الكود الثاني فيه سطر If ActiveSheet.Name <> My_Sheet.Name Then GoTo Exit_Me

الكود الاول يقوم باستدعاء الكودين الثاني والثالث الثالث اسمه تحويل يعمل جيدا المشكله في الكود الثاني لا يعمل مع الاستدعاء من خلال الكود الاول ولكنه يعمل منفصل

اخي الكريم لا يعمل الكود الثالث الكود الاول Sub ehab1() Dim my_sh As Worksheet: Set my_sh = Sheets("سندات القبض") Dim Sanad As Worksheet: Set Sanad = Sheets("سند قبض") X = my_sh.Cells(Rows.Count, 2).End(xlUp).Row + 1 With my_sh.Range("a" & X) '.Value = Sanad.[d5].Value .Offset(0, 1).Value = Sanad.[h4].Value .Offset(0, 2).Value = Sanad.[d5].Value .Offset(0, 3).Value = Sanad.[g7].Value .Offset(0, 4).Value = Sanad.[e7].Value .Offset(0, 5).Value = Sanad.[c7].Value .Offset(0, 6).Value = Sanad.[a7].Value .Offset(0, 7).Value = Sanad.[d10].Value .Offset(0, 8).Value = Sanad.[a10].Value .Offset(0, 9).Value = Sanad.[i9].Value .Offset(0, 10).Value = Sanad.[i12].Value .Offset(0, 11).Value = Sanad.[i13].Value .Offset(0, 12).Value = Sanad.[i14].Value .Offset(0, 13).Value = Sanad.[i15].Value .Offset(0, 14).Value = Sanad.[i16].Value End With With Sanad 'MsgBox ("تم الحفظ") End With copy_data_Salim tahwiell End Sub الكود الثاني Sub copy_data_Salim() Dim My_Sheet As Worksheet Set My_Sheet = Sheets("سندات القبض") Dim Target_Sh As Worksheet If ActiveSheet.Name <> My_Sheet.Name Then GoTo Exit_Me Dim laste_row% Dim Const_Srting$: Const_Srting = "تم الترحيل" Dim k%, m%, i%, t% Dim Source_Array() ReDim Source_Array(1 To 11) Source_Array = Array("B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "N") Dim Target_Array() ReDim Target_Array(1 To 11) Target_Array = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M") k = My_Sheet.Cells(Rows.Count, 2).End(3).Row On Error Resume Next For i = 2 To k m = My_Sheet.Cells(i, Columns.Count).End(1).Column If My_Sheet.Cells(i, "q") = Const_Srting Then GoTo Next_I Set Target_Sh = Sheets(My_Sheet.Cells(i, "P") & "") laste_row = Target_Sh.Cells(Rows.Count, 3).End(3).Row + 1 For t = LBound(Source_Array) To UBound(Source_Array) Target_Sh.Cells(laste_row, Target_Array(t)) = _ My_Sheet.Cells(i, Source_Array(t)) Next My_Sheet.Cells(i, "Q") = Const_Srting Next_I: Next Exit_Me: Erase Source_Array: Erase Target_Array Application.ScreenUpdating = True End Sub الكود الثالث Sub tahwiell() 'نقل البيانات Application.Calculation = xlManual Dim FS, FR, TS, TR FS = "سند قبض" FR = "a10" TS = Sheets(FS).Range("A7") TR = Sheets(FS).Range("i26") Sheets(FS).Range(FR).Copy Sheets(TS).Range(TR).PasteSpecial Paste:=xlPasteValues Application.Calculation = xlAutomatic ActiveSheet.EnableSelection = xlUnlockedCells End Sub

يوجد كود قمت بعمل استدعاء لكود اخر عن طريق CALL وقمت بعمل استدعاء كود اخر ثالث عن طريق CALL لكن كود يعمل وكود لا يعمل

لا حول ولا قوة الا بالله

اللهم صلي علي سيدنا محمد

السلام عليكم مرفق ملف ايجارات يوجد لكل عمارة صفحه بها بيانات المستأجرين المطلوب نقل بيانات المستأجر بالكامل الي صفحه المتأخرين عن السداد لو كان عدد الايام اكبر من صفر المطلوب رقم 2 يوجد صفحه اسمها سند قبض في الخليه A10 نهاه التاريخ المدفوع اريد يتم ترحيله الي خليه نهايه الايجار في صفحه العمارة مع صف المستأجر المحددين اعلي السندالايجارات.xlsm

تماااااام جزاك الله خيرا

ممتاز جدا هل من الممكن استخراج السنوات في الخليه والشهور في خليه اخري والايام في خليه ثالثه ممكن جداً dATE_IF 1.xlsx

السلام عليكم مطلوب معرفه عدد كام سنه وكام شهر وكام يوم في عدد ايام مثلا 400 يوم عن طريق دوال او كود يقوم باستخراج عدد السنين 1 والشهور 1 والايام 10 ولكم الشكر

تمام جزاك الله كل خير هذا هو المطلوب بالظبط

السلام عليكم مرفق الملف بدون تنسيقات المطلوب ترحيل من العمود B الصفحه سندات قبض الي العمود C في صفحه العميل ترحيل من العمود C الصفحه سندات قبض الي العمود D في صفحه العميل ترحيل من العمود D الصفحه سندات قبض الي العمود E في صفحه العميل ترحيل من العمود E الصفحه سندات قبض الي العمود F في صفحه العميل ترحيل من العمود F الصفحه سندات قبض الي العمود G في صفحه العميل ترحيل من العمود G الصفحه سندات قبض الي العمود H في صفحه العميل ترحيل من العمود H الصفحه سندات قبض الي العمود I في صفحه العميل ترحيل من العمود I الصفحه سندات قبض الي العمود J في صفحه العميل ترحيل من العمود J الصفحه سندات قبض الي العمود K في صفحه العميل ترحيل من العمود K الصفحه سندات قبض الي العمود L في صفحه العميل ترحيل من العمود N الصفحه سندات قبض الي العمود M في صفحه العميل الايجار Salim.xlsm

السلام عليكم ورحمه الله بارك الله فيك اخي الكريم الكود يعمل بشكل ممتاز جزاك الله خير اود التعديل البسيط السهل ان شاء الله 1-ان يقوم بالنسخ واللصق بدون التنسيقات (لصق خاص) 2- ان يقوم بترحيل بعض الخلايا من الصف وليس الصف الكامل مثل هذا الجزء في الكود السابق ////// رد ارفع الملف الجديد (بدون تنسيقات) مع ذكر الاعمدة التي تريد تسخها (العامود كذا من الصفحة الاولى الى العامود كذا من الصفحة الثانية) لاني قد مسحت الملف من عندي

السلام عليكم مرفق ملف به الكود علي الملف وبه خلل كبير علي الرغم من وجود كلمه تم الترحيل يقوم بالترحيل كل البيانات جديد وقديم ويقوم بكتابه كلمه تم الترحيل في العمود بالكامل لا اعلم الخلل ارجوا الافادة الايجار ehab.xlsm

تمام براجع الكود وبخبرك بالنتيجه شكرا اخي الكريم

اتوقع ان لو غيرت k هيأثر علي قيمه i وهيأثر علي قيمة الترحيل لا علاقة للــ k يهذا الامر (أصلاً يمكن حذف هذا المتغير k الذي لا دور له)

جزاك الله خير لكن الكود يعمل بالكامل اول مرة لكن المرة الاخري لا يعمل /// رد طبعاً لن يعمل لانه أضاف عبارة" تم الترحيل "في المكان المناسب لكن اذا اضفت بيانات جديدة سوف ترحل كالعادة و يقوم الكود باضافة هذه العبارة مجدداً في نهايةكل سطر من البيانات الجديدة عند اضافه بيانات في الصفوف الاخري لا يعمل الكود تم اضافه بيانات جديدة ولم تضاف واعتقد ان المتغير i = 2 To k اي ان الصفوف من 2 الي 4 فقط والله اعلم /////// استبدل الحرف K بــــ LrP For i = 2 To Lrp

الاخوة الكرام ارجوا اضافه كلمه تم الترحيل الي اخر عمود في الجدول وهو العمود (q) ويوضع شرط في الكود عدم ترحيل الصف طالما موجود كلمه تم الترحيل حاولت عملها لكن لم تظبط معي ارجوا المساعده الايجار ehab.xlsm

هل من طريقه لتصحيح الكود

اخي الكريم تم تجربه الكود ويوجد بعض المشاكل وهو يقوم بترحيل اخر عمليه لكل الكشوف حتي لو تم ترحيلها وارجوا العمل علي الكود هذا Sub REPORT_salim() Application.ScreenUpdating = False Dim My_name$ Dim SpecLr% Dim sh As Worksheet: Set sh = Sheets("سندات القبض") Dim k%, i%: k = Sheets.Count Dim LrP%: LrP = sh.Cells(Rows.Count, "P").End(3).Row If LrP = 1 Then LrP = 2 For i = 2 To k My_name = sh.Cells(i, "P") SpecLr = Sheets(My_name).Cells(Rows.Count, "c").End(3).Row + 1 With Sheets(My_name) .Cells(SpecLr, 3) = sh.Cells(i, "B") .Cells(SpecLr, 4) = sh.Cells(i, "D") .Cells(SpecLr, 5) = sh.Cells(i, "e") .Cells(SpecLr, 6) = sh.Cells(i, "f") .Cells(SpecLr, 7) = sh.Cells(i, "h") .Cells(SpecLr, 8) = sh.Cells(i, "i") .Cells(SpecLr, 9) = sh.Cells(i, "g") .Cells(SpecLr, 10) = sh.Cells(i, "k") .Cells(SpecLr, 11) = sh.Cells(i, "n") .Cells(SpecLr, 12) = sh.Cells(i, "l") End With Next Application.ScreenUpdating = True End Sub

جزاك الله خير . جاري التجربه

جزاك الله خير لكن طلب اخير بخصوص الموضوع هل يوجد طريقه لمنع تكرار الترحيل البيانات التي تم نقلها