احمدزمان

السلام عليكم ورحمة الله وبركاته جاري التجربة جزاكم الله خيرا

السلام عليكم و رحمة الله تاكد من اسم الملف الموجود في الرساله و تاكد من اسم الماكرو المرتبط بالزر

السلام عليكم و رحمة الله وبركاته في الخلية M1 غير كلمة البيان الى نوع العملية حيث ان الجدول لا يوجد به كلمة البيان مع التحية

السلام عليكم و رحمة الله وبركاته ضع الدالة =SUM(N4;C5;K5)-SUM(G5;L5) ثم اسحبها للاسفل مع التحية

و عليكم السلام و رحمة الله وبركاته Sub Add_One() Dim FR For FR = 10 To 50 Cells(FR, 3) = Val(Cells(FR, 3)) + 1 Next MsgBox "plus 1 add to all" End Sub زائد1.xlsm

السلام عليكم و رحمة الله وبركاته يوجد تداخل بين الرموز التي انت كاتبها و اسماء الاعمدة و الخلايا في اكسل مثال NN ممكن يون اسم عامود اورمز انت واضعه وغيرها لذلك لم نفهم المطلوب فضلا التعديل الى مسميات اعمدة واضحة ليتمكن الاخوة من مساعدتك

آمين يارب نحن و انت وجميع المسلمين

اخي الكريم الدالة SUBSTITUTE تقوم باستبدال احرف اي نص بقيمة جديدة و انت اردت التخلص من السطر الجديد و هو مفتاح انتر Emter وهذا المفتاح يرمز له في كود المناتيح بـ Char(10) لذلك تقوم الدالة باستبداله الى " -" في اي مكان في النص جزاك الله خيرا اعتذر ان لم استطع الرد على اي نسائل آخر حيث انني متوجه الى الحج بعد قليل - و البركة في بقية الاخوة في المنتدى ,,, دمتم بخير

و عليكم السلام و رحمة الله وبركاته في الخلية Q3 ضع الدالة التالية =SUBSTITUTE(TRIM(P3);CHAR(10);" -") قد يكون هذا طلبك و الله اعلم

و عليكم السلام و رحمة الله و بركاته تقبل الله من الجميع =INDEX(D3:M3;;MATCH(MAX(D5:M5);D5:M5;0)) اعلى-ادنى.xlsx

اللهم آمين انا و انت و جميع المسلمين شكرا لك

اخي عبدالله كللامك مظبوط يوجد خطاء تم تعديله و كان الخطاء في الحلقة الدائرية للتاكد من خلو الخلية الهدف من اي بيانات للكتابه بها سامحنا ... كل ابن آدم خطاء البرنامج.xlsm

طيب اراجعه ان شاء الله

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

جزاك الله خيرا تم التعديل كما طلبت في المرفق البرنامج.xlsm

‏الاثنين‏، 5‏/7‏/2021م الموافق ‏26‏/11‏/1442هـ طريقة الاستخدام يتم فتح الملفين : البرنامج و البودرة من ملف البرنامج الذهاب الى ورقة TransPorter اضغط على خطوة 1 سوف يتم تحديث بيانات القوائم المنسدلة ببيانات جميع الملفات المفتوحة من اسم الملف و أسماء الأوراق في ككل ملف ابدء بتعبئة البيانات في الجدول كامل حدد أسماء الملفات المصدر و الوجهة و أسماء الأوراق المنقولة منها البيانات و اسم الرقة الهدف التي سوف توضع بها البيانات ثم اضغط زر ابدء نقل البيانات يتم نقل البيانات من جميع الأوراق الى الورقة الحالية مع التحية الصورة للشاشة الاكواد المستخدمة 'عمل قائمة اسماء الملفات Application.ScreenUpdating = False WBK1 = ActiveWorkbook.Name Set TS = Workbooks(WBK1).Sheets("TransPorter") TS.Unprotect 'Password:=Range("PW") TS.Range("A4:B99").ClearContents R = 4 For WB = 1 To Workbooks.Count BN = Workbooks(WB).Name For Sh = 1 To Workbooks(BN).Sheets.Count TS.Cells(R, 1) = BN TS.Cells(R, 2) = Workbooks(BN).Sheets(Sh).Name R = R + 1 Next Sh R = R + 1 Next WB 'TS.Range("AB4").ClearContents TS.Range("K3") = WBK1 [I3] = "" [H6] = "" [K6] = "" Application.ScreenUpdating = True 'Application.Run "Data_TransPorter01_Clear" 'Application.Run "Protct" ActiveSheet.EnableSelection = xlUnlockedCells -- Dim WB1N, WB2N, WB3N, FDT, TDT, DTC, FC1, FC2, TC, TR Dim TSH, SHN, CC, CC2, CC3 Dim RN1 As Range If Sheets("TransPorter").Range("Q14") = False Then QQ = Sheets("TransPorter").Range("Q15").Text MsgBox QQ, vbMsgBoxRight, "أكمل البيانات المطلوبة" Exit Sub End If 'CreateObject("Wscript.shell").Popup "إنتظر قليلاً حتى الإنتهاء من معالجة البيانات", 0, "إنتظار !!!!", vbExclamation WB1N = Range("I3").Text WB2N = Range("K3").Text WB3N = ActiveWorkbook.Name 'اسم ملف ورقة الأوامر ORDERSHET = ActiveSheet.Name 'ورقة الإعدادات او الأوامر TSN = Range("K4").Text Set WB1 = Workbooks(WB1N) 'من ملف Set WB2 = Workbooks(WB2N) 'الى ملف Set WB3 = Workbooks(WB3N) 'ملف البيانات Set OSH = WB3.Sheets(ORDERSHET) Set TS = WB2.Sheets(TSN) 'الى الورقة ActiveSheet.Unprotect ' Password:=Range("PW") TS.Unprotect 'Password:=WB2.Range("PW") FDT = OSH.Range("K6").Value 'من تاريخ TDT = OSH.Range("K7").Value 'الى تاريخ DTC = OSH.Range("M9").Text 'عمود التاريخ لملف مصدر البيانات FC1 = OSH.Range("K8").Text 'من العمود FC2 = OSH.Range("M8").Text 'و العمود TC = OSH.Range("L10").Text 'العمود الوجهة TR = Val(OSH.Range("L11")) 'الصف الوجهة ' Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False ' For SHN = 5 To 14 If OSH.Cells(SHN, 16) <> True Then GoTo 1 FSN = OSH.Cells(SHN, 8).Text Set FS = WB1.Sheets(FSN) ER = FS.UsedRange.Rows.Count + 11 For R = 1 To ER QDT = FS.Range(DTC & R).Value If QDT >= FDT And QDT <= TDT Then CC2 = Val(Cells(1, FC1).Column) ' من عمود رقم CC3 = Val(Cells(1, FC2).Column) ' الى عمود رقم ' التأكد من فراغ الصف الوجهة TR 7 For Each RN1 In Range(Cells(TR, CC2), Cells(TR, CC3)) If RN1 <> "" Then TR = TR + 1 GoTo 7 End If Next 'RN1 ' نقل بيانات الصف For CC = CC2 To CC3 TS.Cells(TR, CC) = FS.Cells(R, CC) Next 'CC TR = TR + 1 End If Next 'R 1 Next 'SHN OSH.Select 'Application.Run "Data_TransPorter01_Clear" 'Application.Run "protct" Application.Calculation = xlAutomatic Application.EnableEvents = True البرنامج.xlsm

لانك في سطرين فقط كاتب ok في العمود 14 و السطور الثانية لا يوجد بها اوكي

و عليكم السلام و رحمة الله وبركاته جرب هذا الموضوع ان شاء الله تجد به ما تريد https://www.officena.net/ib/topic/38355-مكتبة-الموقع-مُجمِع-البيانات-للاكسيل-excel-data-collector/ وهو للعلامه محمد طاهر

السلام عليكم و رحمة الله وبركاته لست فاهم ممكن توضح اكثر يعني هوه بعد تعبئة الجدول بيرحل الى ورقة ثالثة اذا ممكن نضع الشرط مربوط ب الورقة الثالثة التي بها كل البيانات صح

السلام عليكم و رحمة الله وبركاته بالاضافة الى حل اخي الفاضل عبدالله جزاه الله خيرا هذا حل آخر بطريقة اخرى مع التحية test01.xlsx

وهذا حل آخر يارب يكون صحيح الخطوات المتبعة 1 نقوم يتفكيك تاريخ البداية الى يوم و شهر وسنة - كل واحد في خانة 2 نحول التاريخ الميلادي لليوم الى تاريخ هجري 3 نفكك التاريخ الذي حولناه الى يوم و شهر وسنة - كل واحد في خانة 4 نبدء نحسب يوم ناقص يوم و شهر ناقص شهر و سنة ناقص سنة كما في المرفق وهكذا نفذت مني الحلول hgry3.xlsx

مرفق hgry2.xlsx

السلام عليكم اخي الكريم افضل و اقرب حل اجدة حاليا وقريب من ذهني هو الدالة days360 و التي تقوم بحساب السنة على اساس 360 يوما = 30×12 مع التحية

الخلية N3 بها شرط اكتمال البيانات =AND(G4<>"";K4<>"";D5<>"";K5<>"";D6<>"";K6<>"";D7<>"";K7<>"";D8<>"";B10<>"") الخلية N4 تظهر بها اسماء البيانات الناقصة =CONCAT(IF(G4="";E4&" -";"");IF(K4="";I4&" -";"");IF(D5="";B5&" -";"");IF(K5="";I5&" -";"");IF(D6="";B6&" -";"");IF(K6="";I6&" -";"");IF(D7="";B7&" -";"");IF(K7="";I7&" -";"");IF(B10="";H9&" -";"")) الخلية N5 بها نص الرسالة =IF(N3;"";CONCAT("اكمل ادخال البيانات الناقصة";CHAR(10);CHAR(10);N4)) تم اضافة الى الكود مع الترحيل If FS.Range("N3") = False Then Dim Q1 Q1 = FS.Range("N5").Text MsgBox Q1, vbMsgBoxRight, "خطاء" Exit Sub End If مع التحية y02.xlsm