احمدزمان

السلام عليكم و رحمة الله وبركاته اخي الكريم جعفر جزاك الله خيرا على هذا العمل الرائع انا متأكد ان هذا ليس الا جزء بسيط من علمكم الذاخر الذي استفدنا منه جميعا بارك الله فيك تقبل مروري Aymz077

وعليكم السلام و رحمة الله وبركاته اسعد الله صباحك بكل خير الإندثار او مايعرف لدينا بالإهلاك السنوي

السلام عليكم و رحمة الله وبركاته سوف يقوم الكود بالتالي حيث ان الورقة التي ينقل اليها البيانات هي ليست ورقة عمل لذلك يتم ادراج ورقة عمل جديدة ونقل البيانات اليها توزيع البيانات على الأعمدة تصحيح صيغة التاريخ من mm/dd/yyyy الى dd/mm/yyyy فرز البيانات وترتيبها تنازليا Sub Reset_New_Data() ' تحديث بيانات تم جلبها من ملف خارجي Dim FS As Worksheet, TS As Worksheet, RN1 As Range Dim ER Set FS = Sheets(ActiveSheet.Name) Sheets.Add Set TS = Sheets(ActiveSheet.Name) FS.UsedRange.Copy TS.Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False 'Set RN1 = TS.UsedRange ER = TS.UsedRange.Rows.Count + 3 Set RN1 = TS.Range("A1:A" & ER) ' Range("B1:K1").EntireColumn.Insert RN1.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _ :="/", FieldInfo:=Array(Array(1, 4), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True ' Range("B1:D1").EntireColumn.Insert RN1.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _ TrailingMinusNumbers:=True Range("D1:D" & ER).FormulaR1C1 = "=DATE(RC3,RC1,RC2)" Range("D1:D" & ER).Copy Range("D1:D" & ER).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("A:C").Delete Shift:=xlToLeft Range("A1:O1").ClearContents ActiveSheet.UsedRange.Select Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Selection.Font.Size = 13 Selection.Columns.AutoFit Range("A1").Select End Sub طريقة الإستخدام تقوم بفتح الملف الذي تم الجلب البيانات اليه (الملف الجديد) تفتح هذا الملف تضغط بزر الماوس الأيمن على زر تحديث الموجود في هذا الملف تختار نسخ تذهب الى الملف الجديد - الورقة التي بها البيانات التي تم جلبها تضغط بزر الماوس الأيمن على أي مكان في الورقة التي بها البيات تختار لصق يتم ادراج الزر في الورقة اضغط على الزر بزر الماوس الأيسر يتم عمل المطلوب توزيع البيانات و فرزها.rar

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

السلام عليكم و رحمة الله وبركاته اعمل اظهار للملف personal ثم فم باغلاق الملف ثم افتح اي ملف فيه ماكرو وجرب لعل و عسى

السلام عليكم و رحمة الله وبركاته اخي الحديثة ادخل على الكود الي عملناه السطر الذي يوجد به الرقم 0 صفر If Val(FS.Cells(ER1, 96)) > 0 Then عدله بدل 0 ضع 5 If Val(FS.Cells(ER1, 96)) > 5 Then الآن يرحل اكبر من 5 = بمعنى سته او اكثر خالص تحياتي

السلام عليكم و رحمة الله اخ محمود عملنا 3×1 ترحيل الصفحة + ترحيل للجدول + طباعة صورة الطابعة الموجودة في الورقة اضغط عليها يتم تنفيذ الكل Xl0000016.rar

السلام عليكم و رحمة الله وبركاته اخي الحديثة جرب المرفق يتم اضافة اسم الصف اعلى الورقة ثم اسماء الغياب الحديثة.rar

السلام عليكم و رحمة الله وبركاته الدفاع عن النفس هذي حاجة تخوف شاهد الحل المرفق Sub TARHEEELL() ' ترحيل من sheet1 الى تقرير Dim FS As Worksheet, TS As Worksheet Dim R, ER1, ER2 Set FS = Sheets("Sheet1") Set TS = Sheets("تقرير ") FS.Range("B66:H66").Copy For ER2 = 6 To TS.UsedRange.Rows.Count + 9 If TS.Cells(ER2, 2) = "" Then TS.Range("B" & ER2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End End If Next ER2 End Sub مع التحية Xl0000016.rar

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

((من قال لاأدري فقد أفتى))

السلام عليكم و رحمة الله وبركاته لقد تم عمل هذا الملف بشكل بدائي جدا وبسيط جدا بدون أي تعقيدات أو حماية أو إغلاق خلايا. مرفق ملف للشرح مخزن2015.rar

مأجورين ان شاء الله

السلام عليكم شاهد احد ابداعات علامة المنتدى عبدالله باقشير http://www.officena.net/ib/topic/36524-فورم-لحفظ-نسخة-من-الملف/?do=findComment&comment=193395

السلام عليكم و رحمة الله وبركاته اخي ابو جنا - ادخل الى تنسيق الخلايا Format - Ctrl+1 - اختار التبويب حماية Protect وهو آخر تبويب - الغي التأشير الموجود على خيار مخفيةHiden وبهذا يمكنك التعديل باستخدام F2 jpdhjd

اخي الكريم هذا حل آخر بكود ايضا كود التصفية المتقدمة استخلاص بيانات من أعمده وصقوق.rar مع مراعات الدوال الموجودة في الصف 4 Sub mod_1() Range("DATA").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("ORDER"), _ CopyToRange:=Range("OUTBUT"), Unique:=False End Sub

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

السلام عليكم اخي لا طامه ولا شي بسيطة ان شاء الله

‏الخميس‏، 3‏/9‏/2015م الموافق ‏20‏/11‏/1436هـ السلام عليكم اخي ابو نباء جزاك الله خيرا اخي ابو حازم بسيطة ادخل على الكود تجد كلمة ورقة2 غيرها الى ورقة 3 يرحل الى ورقة 3 غيرها الى ورقة4 يرحل الى ورقة 4 وهكذا

السلا عليكم و رحمة الله

السلام عليكم و رحمة الله وبركاته شوف نفس الكلام الي قلناه اول طبقناه على الملف حقك Xl0000.rar

‏الخميس‏، 3‏/9‏/2015م الموافق ‏20‏/11‏/1436هـ السلام عليكم و رحمة الله وبركاته اخي الحجازي بالإضافة للحلول الرائعة من الإخوة بن علية و خالد الرشيدي وايضا حل آخر =INDEX($F$4:$F$9;MATCH($A2;$D$4:$D$9;1)) مرفق مع الشرح Xl00000.rar

السلام عليكم و رحمة الله وبركاته الأستاذ القدير ياسر خليل تركيبة رائعة من الدوال هذا اسمه ابداع و تمكن جزاك الله خيرا

وهذا الحل باستخدام كلمة مرحل hhhh-مرحل.rar

وعليكم السلام و رحمة الله اخي المبدع خالد الرشيدي فكرة جميلة و منطقية و لم تخطر ببالي جزاك الله خيرا و هذا الحل بالطريقة التي ذكرها الأخ الفاضل خالد ER2-hhhh.rar