نجوم المشاركات

الأخوة والأساتذة الكرام طلب أحد الأخوة نسخ الخلية النشطة مع صفها من شيت الى شيت آخر فى هذا الرابط http://www.officena.net/ib/index.php?showtopic=62805 ولعموم الفائدة أضع بين أيديكم كود نسخ الخلية النشطة وبعدها عدد محدد من الخلايا وليكن 5 خلايا مثل النسخ من A5 الى F5 Sub mokhtest2() Application.ScreenUpdating = False ActiveCell.Resize(1, 6).Copy Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) ' لنسخ ولصق النشطة بالفورمات وبعدها 5 خلايا Application.ScreenUpdating = True Application.CutCopyMode = False End Sub الجزئية ActiveCell.Resize(1, 6).Copy معناها نسخ الخلية النشطة مع 5 خلايا بعدها فى نفس الصف وده = 6 الجزئية Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) هى وجهة اللصق أول فارغة فى العمود 1 فى الشيت مستودع واللصق يكون للقيم والفورمات باقى الكود للتسريع وتفريغ الذاكرة العشوائية المرفق copy row based on ActiveCell mokhtar .rar

لتعم الفائدة والإستفادة للجميع شرح دوال الاكسيل.rar

السلام عليكم ورحمة الله وبركاته مكتبة تحتوى على العديد من الكتب فى لغات البرمجه http://kutub.info/library/category/1

أرجوا أن ينال رضا الجميع وكل عام وأنتم بخير تقبلوا خالص تحياتى Excel Formulas.rar

اخواني في المنتدى لماذا لا تدعون المستخدم يختار عدد الصفوف و الاعمدة المطلوبة ابتذاءً من الخلية المحددة (بدل ان يدخل الى الكود و يقوم بهذا الشيء) عبر هذا الكود Sub CopyRowActiveCell() Dim WS As Worksheet, SH As Worksheet, LR As Long Set WS = Sheets("Sheet1"): Set SH = Sheets("Sheet2") LR = SH.Cells(Rows.Count, 1).End(xlUp).Row myrow = Application.InputBox("حدد عدد الصفوف", Default:=1) mycol = Application.InputBox("حدد عدد الاعمدة", Default:=1) ActiveCell.Resize(myrow, mycol).Copy SH.Cells(LR + 1, 1).PasteSpecial (xlValues) Application.CutCopyMode = False End Sub

أو يمكن استخدام هذا الكود بدون اللجوء إلى استخدام طريقة النسخ أو الحلقات التكرارية Sub CopyRowActiveCell() Dim WS As Worksheet, SH As Worksheet, LR As Long Set WS = Sheets("بيانات"): Set SH = Sheets("مستودع") LR = SH.Cells(Rows.Count, 1).End(xlUp).Row + 1 SH.Cells(LR, 1).Resize(1, 6).Value = WS.Cells(ActiveCell.Row, 1).Resize(1, 6).Value End Sub

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("g14")) Is Nothing Then m = Target.Value n = Target.Offset(1, 0).Value + m Target.Offset(1, 0) = n Target.Value = "" Target.Select Application.EnableEvents = True End If Application.EnableEvents = True End Sub

بارك الله فيك أخي الحبيب مختار إليك كود آخر لا يرقى لمستوى كودك بالطبع ..فكودك هو الأيسر والأسهل Sub CopyRowActiveCell() Dim WS As Worksheet, SH As Worksheet Dim lrWS As Long, lrSH As Long, I As Long Set WS = Sheets("بيانات"): Set SH = Sheets("مستودع") lrWS = ActiveCell.Row lrSH = SH.Cells(Rows.Count, 1).End(xlUp).Row + 1 For I = 1 To 6 SH.Cells(lrSH, I) = WS.Cells(lrWS, I) Next I End Sub

نستأذن الأخ الكريم أبو صاصا في حذف الموضوع وعليه أن يقوم بطرح موضوع جديد من البداية يوضح فيه طلبه بشكل تفصيلي وإن شاء المولى من لديه علم تأكد أنه لن يبخل به عليك فقط ما عليك سوى التوضيح الكافي .. لأنه في وجهة نظري المتواضعة أن توضيح المشكلة يمثل 90% من حل المشكلة

السلام عليكم الأخ الكريم فتحى سلام ... لقد تحول الموضوع بفضلك من مشكلة تبحث لها عن حل الى حوارات المخطئ و المصيب فينا و قيل و قال و أقصد و لغة عربية و علمى متأدب و تفرعنا من نقطة لأخرى لا تصب فى مصلحة الموضوع .. كلنا أخوة ندافع عن بعضنا البعض العادل فينا ندعمه و الظالم فينا نقومه و يا سيدى أنا المخطئ و حقك علي ، فالنعد للموضوع الأساسي يرجى موافاتنا بقدر مناسب من البيانات للعمل عليه ( راجع المشاركتين 2 و 3 ) ..لو كنا بالفعل نستخف بك ما إعطيناك إهتمام .. و لكن كما ترى الجميع يسارعون فى مساعدة بعضهم البعض .. و نحن هنا بإنتظار مزيد من التوضيح لطلبك دمت بخير و اعزك الله

بسم الله والصلاة السلام على رسول الله وعلى آله وصحبه ومن والاه أما بعد: السلام عليكم أساتذتي الكرام... لقد رأيت كتابة مشاركة الأخ أبو صاصا المحترم في المشاركة 8 حسن الكلام ورجاحة العقل والكلمات الموزونة لذلك تبادر إلى ذهني السؤال التالي: لم تسرع في البداية وأطلق أحكاماً جائرة فكلمة جانبك الصواب وإن كانت أخف وطئاً من كلمة أخطأت إلا أنها تؤدي إلى النتيجة ذاتها ...فليكن حسن الظن وإعذار الطرف الآخر سائداً بين الكل فنحن نتواصل بالكلمة وتعلمون أن الله تعالى أثنى على الكلمة الطيبة وذم تلك الخبيثة بقوله تعالى:﴿ أَلَمْ تَرَ كَيْفَ ضَرَبَ اللَّهُ مَثَلًا كَلِمَةً طَيِّبَةً كَشَجَرَةٍ طَيِّبَةٍ أَصْلُهَا ثَابِتٌ وَفَرْعُهَا فِي السَّمَاءِ (24) تُؤْتِي أُكُلَهَا كُلَّ حِينٍ بِإِذْنِ رَبِّهَا وَيَضْرِبُ اللَّهُ الْأَمْثَالَ لِلنَّاسِ لَعَلَّهُمْ يَتَذَكَّرُونَ (25) وَمَثَلُ كَلِمَةٍ خَبِيثَةٍ كَشَجَرَةٍ خَبِيثَةٍ اجْتُثَّتْ مِنْ فَوْقِ الْأَرْضِ مَا لَهَا مِنْ قَرَارٍ (26) يُثَبِّتُ اللَّهُ الَّذِينَ آَمَنُوا بِالْقَوْلِ الثَّابِتِ فِي الْحَيَاةِ الدُّنْيَا وَفِي الْآَخِرَةِ وَيُضِلُّ اللَّهُ الظَّالِمِينَ وَيَفْعَلُ اللَّهُ مَا يَشَاءُ (27) ﴾ ] سورة إبراهيم الآية:24-27 [في بعض الأحاديث الشريفة)) : الكلمة الطيبة صدقة] ((أخرجه مسلم وابن خزيمة في صحيحه عن أبي هريرة [ ))إن الرجل ليتكلم بالكلمة -من رضوان الله تعالى-, يرقى بها إلى أعلى عليين, وإن الرجل ليتكلم بالكلمة -من سخط الله تعالى-, يهوي بها إلى أسفل سافلين(( ورد في الأثر [ البطولة أن تعد كلامك من عملك, فالكلمة الطيبة صدقة, والكلمة الخبيثة يهوي بها الإنسان إلى أسفل سافلين. وكل ابن آدم خطاء...فليبحث كل منا عن عذر لصاحبه ...ألا تحبون أن يغفر الله لكم...فليغفر كل منا زلة صاحبه ..فلسنا بمعصومين وهنا أقول كلا مي ناصحاً بذلك نفسي بداية وكل من يقرأ كتابتي هذه أنتم كلكم خير مني ولكن أرى نفسي محباً لنصح إخوتي ليبقى قلب كل منا سليم باتجاه إخوته...ولنتمسك بسيد الأخلاق لأننا نعيش حياة عبور لا تستحق منا أن نعرض عن بعضنا فإن لاقى كلامي هذا قبولاً منكم فلله الفضل والمنة وإن كان غير ذلك فإنني أعتذر تقبلوا مروري واحترامي والسلام عليكم ورحمة الله وبركاته..أخوكم أبو يوسف...

الأساتذة الكرام ياسر خليل أبو البراء وخالد الرشيدي ومختارحسين محمود المحترمين السلام عليكم ورحمة الله وبركاته.. أعمالكم كلها جيدة ورائعة ومميزة ...كلها تصب ببوتقة واحدة ولذلك أراها كلها رائعة ولا أقول إلا جزاكم الله خيراً..وكلها موضع إعجاب. تقبلوا تحياتي واحترامي... والسلام عليكم ورحمة الله وبركاته..

الأخ الحبيب فتحي سلام لا داعي للاعتذار فكلنا هنا أخوة يجمع بيننا الحب والمودة والألفة .. أنا دائماً وأبداً أحرص على المنتدى بشكل عام .. فأقوم بحذف المشاركات الغير مجدية في بعض الأحيان وحينما أرى موضوع مكرر أنظر إلى كلاهما بدقة - ويعلم الله أني أدقق في الأمر - ثم إذا وجدت في أحد الموضوعين مرفق والآخر لم يكن هناك مرفق أقوم بحذف الموضوع الغير مناسب والذي لا يوجد به مرفق ، ولا أرى أن هناك داعي لإخبار صاحب الموضوع إذ أن موضوع الحذف لا يهمه في شيء في هذه الحالة أمر آخر ... وجب التنبيه عليه .. في الحالة التي أقدمت عليها لم أحذف الموضوع بل قمت بتغيير عنوان الموضوع ليناسب طلبك ثم لتجد الإقبال من الأخوة الكرام عليه وإلا لن تجد إقبال بعنوان غير معبر أرجو أن تتفهم العمل في المنتدى وألا تغضب ... راجع التوجيهات بدقة حتى تستطيع التجاوب في المنتدى وكلنا هنا ولابد أن تعلم ذلك جيداً لا يخفي علم عن إخوانه بالعكس الكل يبحث وينقب حتى نصل في النهاية لحل مشكلة إخوانهم إن كانت مستعصية وما أحزنني في كلامك كلمة واحدة .. نحن لا نستخف بمشاعر أحد ولا نجرح أحد وكونك تبحث عن منتدى آخر يلبي طلبك فربما تجد منتديات أفضل بكثير من منتدانا لتلبية طلباتك ، ولكن تأكد أنه لن تجد الحب والود والألفة والأخوة إلا في منتدانا - وهذا ما يجمعنا في البداية والنهاية - تقبل تحياتي

أخي الكريم خالد يمكن نسخ بيانات الخلية النشطة بدون تنسيقات (بناءً على كود الأخ مختار بدون الإطلاع على الملف) جرب الكود التالي .. (لم أجربه) Sub mokhtest() ActiveCell.Copy Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues End Sub

الأخ العزيز مختار حسين محمود المحترم.. السلام عليكم ورحمة الله وبركاته... عيد فطر مبارك وتقبل الله طاعتكم ...اللهم أعده على عبادك وقد ازدادوا محبة وقرباً أرجو الله أن ينفع بأعمالك الطيبة ..ويرفع من درجاتك في الدنيا والآخرة.. أما من حيث الموضوع والكود الذي وضعته لتغيير الصورة وجعلها على سطح المكتب فأنا أقل من أن أقيم أعمالكم التي تقدمونها بل أقول : جزاكم الله خيراً تقبل تحياتي والسلام عليكم ورحمة الله وبركاته.

السلام عليكم اخوانى وأساتذتى فى المنتدى وكل عام وأنتم بخير بمناسبة عيد الفطر اليوم أقدم لكم كيفية عمل اختصار لملف اكسل به صورتك على سطح المكتب فقد لفت نظرى طلب أحد الأخوة لهذا الموضوع لذلك قررت أن أضع بين أيديكم الطريقة الآتية 1 - فى ملف اكسل أدرج هذا المديول Option Explicit Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GetActiveWindow Lib "user32" () As Integer Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Const CSIDL_PERSONAL = &H5 Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type Dim FSO As New FileSystemObject Dim FLD As Folder Function UserNameOffice() As String UserNameOffice = Application.UserName End Function Public Function DesktopAddress() As String DesktopAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator End Function Private Function GetSpecialFolder(CSIDL As Long) As String Dim Path As String Dim FolderPath As Object Dim IDL As ITEMIDLIST Dim sh As New Shell32.Shell Set FolderPath = sh.NameSpace(5) If Not FolderPath Is Nothing Then GetSpecialFolder = FolderPath.Self.Path Exit Function End If GetSpecialFolder = "" End Function Function DirExists(strDirectory As String) As Boolean DirExists = (Dir(strDirectory, vbDirectory) <> "") End Function Sub Desktop_Shortcut() Dim WBName As String, Path As String, WB_Link As String, WB_Name As String Dim DesktopPath As String, TargetPath As String, StrSave As String Dim WSHShell As Object, MyShortcut As Object Set WSHShell = CreateObject("WScript.Shell") Dim FSO As Object, Folder As Object, File As Object Set FSO = CreateObject("Scripting.FileSystemObject") Dim WB As Workbook Set WB = ThisWorkbook Dim WSh As Worksheet Set WSh = Sheet1 WBName = WB.Name Path = "MyFile" DesktopPath = WSHShell.SpecialFolders("Desktop") WSh.Range("C2").Value = WB.Name WB_Name = WSh.Range("C3").Value WB_Link = WSh.Range("C4").Value On Error GoTo ErrHandle If Not DirExists("C:\" & WB_Name) Then 'Check C Drive If Not DirExists(GetSpecialFolder(CSIDL_PERSONAL) & "\" & WB_Name) Then 'Check My Documents Set FSO = CreateObject("Scripting.FileSystemObject") 'If not in C Drive or My Documents - then create shortcut FSO.CreateFolder "C:\" & WB_Name ChDir "C:\" & WB_Name SavePicture Sheet1.Image1.Picture, WB_Name & ".ico" 'Picture pasted onto Image1 on Sheet 1 - Link Shortcut Set FSO = CreateObject("Scripting.FileSystemObject") Set MyShortcut = WSHShell.CreateShortcut(DesktopPath & "\" & WB_Link) With MyShortcut .TargetPath = WB.FullName .IconLocation = "C:\" & WB_Name & "\" & WB_Name & ".ico" .WindowStyle = 1 .Description = "EEZIAdmin" .WorkingDirectory = WB.Path .Save End With Else End If End If ErrHandle: Set WSHShell = Nothing End Sub 2 - فى شيت 1 الخلية C3 ضع المعادلة =IF($C$2="";"";IF(MID($C$2;(LEN($C$2)-4);"1")=".";LEFT($C$2;LEN($C$2)-5);IF(MID($C$2;(LEN($C$2)-3);"1")=".";LEFT($C$2;LEN($C$2)-4);""))) وفى الخلية C4 ضع المعادلة الآتية =IF($C$3<>"";$C$3&".lnk";"") 3 - فى شيت 1 ادراج Image وعليها صورة : ندرج الـ Image كالتالى من developet tab ثم insert ثم more controls ثم Microsoft forms 2.0 image ثم ok ارسم الـــــ Image فى الشيت وبعدين كليك يمين عليها واخنر Properties فى قائمة الخصائص التى تظهر دور على الخيار Picture واعمل ادراج لأى صورة من على جهازك على الـ Image واحفظ وشغل الكود لكم كل التحية والتقدير Desktop Shortcut mokhtar.rar

السادة الأفاضل أعضاء وأساتذة وعمالقة هذا المنتدى العظيم الرائع الذى تعلمت وإستفدت منه الكثير والكثير كل عام وحضراتكم بألف صحة وسلامة أقدم لكم اليوم ملف لعله يفيد سيادتكم الرجاء النظر مع إبداء الرأى أرجوا أن ينال رضا الجميع Advance Excel Function Training.rar

أخوتى وأساتذتى ياسر فتحى وياسر خليل و سليم حاصبيا بارك الله فيكم وجازاكم خيرا أخى وأستاذى ياسر خليل بدون مجاملات الأكواد المضافة أكثر من رائعة وغاية فى الرقى وأنت من علمنى الحرص على أن يكون الكود يجمع بين البساطة والدقة والسرعة والمرونة والاختصار جازكم الله عنى وعن تلاميذك خيراً واليك هذه الاضافة أيضا تؤدى نفس الوظيفة بدون اللجوء إلى استخدام طريقة النسخ كما هو الحال فى كودك الثانى بالمشاركة 4 Sub mokhtest3() Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 6).Value = Sheets("بيانات").Cells(ActiveCell.Row, 1).Resize(1, 6).Value End Sub تحياتى

بارك الله فيك و جزاك الله خيرا أخي ياسر فتحي البنا

جزاك الله كل خير الاستاذ فتحي ياسر شرح مميز الف شكر جعله الله في ميزان حسانتك وزادك علما ونفع بك

بارك الله فيك وفي عملك

كشفت عن اللغة طلعت تايلاندي ..!!!! وأنا يدوب ثقافتي شوية عربي

لابد من ضبط هذه الامور في الاساسات في الجداول تم اضافة رقم معرف للدرجة داخل الجدول انظر التقرير الآن : يتم الفرز اولا حسب الدرجة وثانيا حسب الاسم وكل هذا عن طريق ما يسمى بالفرز واتجميع New Microsoft Access Database.rar

تم التطبيق داخل الاستعلام في حقل جديد آمل ان يحقق مطلوبك DB_4.rar

الأخ الكريم كل عام وأنت بخير طلبنا منك مراراً تغيير اسم الظهور للغة العربية بالنسبة لطلبك جرب استخدام دالة Sumif شوف الملف المرفق هل يؤدي بالغرض أم لا؟ مجمع وأوراق 2.rar

كل عام وانتم بخير اولا ثانيا : اضف السطر الجديد للكود خلف زر تحديث ليصبح كالتالي : Private Sub أمر33_Click() If MsgBox("تاكيد العملية ؟ ", vbYesNo) = vbNo Then Undo DoCmd.Requery End Sub بالتوفيق

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

تفضل اخي الكريم الموضوع ببساطة في الماكرو الموجود بالمرفق وهو الغاء ctrl_p تحياتي لك اخوك -------- محمود المصري no ctrl p2.rar

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

ربما كان المطلوب !مجمع و اوراق.zip

أخي أيمن أقواس الكود تكون بهذا الشكل <> انقر هذه العلامة <> ثم الصق ما تريده من معادلات وأكواد بداخلها لتظهر مثل هذا الشكل

السطر ذو اللون الأصفر يعني وجود خطأ .. يرجى إدراج هذا السطر في المشاركة الخاصة بك للإطلاع عليه ويمكن لأحد الأخوة الذين جربوا الكود أن يعلمونا بالنتيجة لمعرفة عمل الكود من عدمه لأن الكود يعمل معي بدون مشاكل

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

الكود يعمل تماماً استاذى ياسر لم اجرب ذلك .. قمت فقط بنسخ الكود ولصقة ليكون هناك مرفق لكود الاستاذ مختار ثم لاحظت النتائج ولم ارجع الى الكود ثانية جزاك الله خيراً اخى الكريم اليك ملف اخر بهذا الكود المبسط فية يتم ترحيل القيمة مختار حسين.rar .................................................... الان اصبح لديك 4 اكواد اختر منهم ما يناسبك

استاذن أ.مختار فى تقديم طرق اخرى لاثراء الموضوع اخى الكريم اليك ثلاثة ملفات احدهما يتم تطبيق الكود بمجرد تحديد اى خلية فى العمود A الثانى يتم الترحيل بتحديد الخلية المراد ترحيلها فى العمود A ثم الضغط على زر ترحيل يجدر الاشارة الى ان معادلة الاستاذ مختار هى الاسهل فى التطبيق ولكنها تقوم بنقل الخلية بجميع تنسيقاتها وان كانت بها معادلة سيتم ترحيل المعادلة ايضاً اما الملفين الاخرين يتم ترحيل القيمة فقط وستجد تطبيقها ضمن الملفات 3 مع اضافة ان شرط للترحيل وهو ان تكون الخلية فى العمود A - بعد اذن استاذى مختار طبعاً - El Rashedy.rar ............................................................. اخى الفاضل هذه المشاركة لاثراء الموضوع لذا قم بتحديد مشاركة الاستاذ مختار كأفضل إجابة

أخى الحبيب على جرب الكوداية دى Sub mokhtest() ActiveCell.Copy Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End Sub معنى الكود انسخ الخلية النشطة والصق فى أول خلية فارغة بالعمود 1 بورقة العمل مستودع بس خلاص حدد الخلية واضغط الزر هتلاقيها فى الشيت مستودع ولو حبيت تضيف خلايا أخرى براحتك تحياتى

بص بقا صورتك الجميلة دي زهقتني ... أنا حذفت الاختصارات من على سطح المكتب ومن على الدرايف C وغيرت صورتك لصورتي اللي باين عليها الإكسيل مش قابلها ونفذت الأمر لقيت صورتك بردو :wallbash: المهم قلت مبدهاش لازم أعمل حاجة عملت كليك يمين على الاختصار لقيت Change Icon نقرت عليها وأنا متغاااااظ .. المفاجأة لقيت الأيقونة الخاصة بالصورة بتاعتي اختارتها وفلحت .. بس أسلوب العافية ده مش بحبه عايز أعرف السبب في عدم التغيير بشكل مباشر للصورة الجديدة

انقر على كلمة Debug وشوف السطر الملون باللون الأصفر .. الكود يعمل عندي بشكل جيد يمكن للأعضاء تجربة الكود وإبداء آرائهم ...

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

أخي الكريم قم بمشاهدة الفيديو التالي لتمكين محتوى الماكرو ..بعدها انقر على زر الأمر "توكل على الله" لتنفيذ أسطر الكود وتنفيذ المطلوب إن شاء الله

مخطئ تماما أيها الأخ الكريم أبو صاصا و كلامك مردود عليه أولا : لم تراعى قواعد المشاركة فى الموقع http://www.officena.net/Tips/Questions.htm خمسة دقائق لن تكلفك الكثير و ستريحك فى التعامل مع الموقع بشكل صحيح و فعال و إيجابى . ثانيا : لم تراعى قواعد المشاركة فى منتدى الأكسيل http://www.officena.net/ib/index.php?showtopic=60147 خمسة دقائق أخرى من وقتك الثمين و ستجد متعة فى التعامل بشكل صحيح و ميسر لك و لكافة الاعضاء ثالثا : جميع القواعد معلنة و بارزة و بمكان واضح و ليس مخفية أو سرية ستجعل منك عضوا متميزا فى أسلوبه و طرحه لمواضيعه سواء كانت سؤال او استفسار او شرح رابعا : أنت بكلامك قد أسئت للمنتدى بشكل صريح دون أن يكون هناك سبب لهذا التهجم و ذلك لأنك أهملت فى قراءة القواعد خامسا : أسئت لأحد المشرفين بشكل واضح و مباشر بالتعرض لإختصاصاته و مهامه الأساسية فهو القائم على تنفيذ قواعد المنتدى بشكل صارم و الا يعتبر مهملا كأى عضو عادى بالمنتدى لا يلتزم بالقواعد و لا يستحق منصبه القائم عليه سادسا : أسئت لغيرك من الأعضاء برغم من أن أحد لم يتأخر فى تقديم يد المساعدة و العون .. نحن هنا جميعا نساعد و نعاون دون أى مقابل الا مرضاة الله سبحانه و تعالى و نقتطع من أوقاتنا لمساعدة غيرنا على حلول مشاكلهم مع الأوفيس و غيره من البرامج أعضاء و مشرفين سابعا : لمجرد عدم حصولك على اجابة تصب جام غضبك على المنتدى برغم عراقته و كذلك كونه من أفضل المنتديات فى مجاله .. أنت لست أول و لا آخر واحد لا يجد لا لطلبه المسئلة قائمة على الفهم الصحيح للمشكلة حتى يتم حلها ( ليس سلق بيض أو قالب محفوظ ) و قائمة على تفهم قواعد الموقع و المنتدى و على إدراك صاحب المشكلة أنه قد أوصل مشكلته بشكل صحيح و مفهوم ثامنا : إن كنت ترى ان تأديه المشرف لمهامه استخفاف و إهانه فإن من واجبى كمسلم نصحك و إرشادك الى أنك مخطئ أخى الكريم من قمة رأسك لأخمص قدميك أرجو منك قراءة القواعد بعناية و قراءة كلامى بشكل صحيح حتى تعلم مكمن الخطأ و لا تظلم أحد فالظلم ظلمات يوم القيامة و بالنيابة عنك أعتذر لأخى الكريم ياسر خليل عما بدر من العضو الكريم من تعرض للمنتدى و له بشكل شخصى ارجو أن يتقبل أسفى و أعتذارى الشديد و لأخوتى الأفاضل 10 دقائق فقط يمكنها أن تجنبنا الخطأ و تقلل منه بشكل كبير بتفهمنا للقواعد تاسعا : الأخ الكريم أبو صاصا .. لم ترد على أى استفسار من الأعضاء و بدلا من ان ينصب همك على المشكلة انصب همك على شخصك و تحول الموضوع لمسئلة شخصية و ثأر وهميا فى مخيلتك .. فلا أنت تعرفنى بشكل شخصى او تعرف الأخ ياسر أو غيره و لا نحن نعرفك حتى نهينك او نستخف بمشاعرك على ما تظن و تعتقد عاشرا : نحن هنا جميعا فى خدمة بعضنا البعض دون مقابل الا مرضاة الله سبحانه و تعالى و كل شخص على قدر معرفته و علمه و كل منا يختفى وراء كلماته التى تفضح شخصيته الكلمة الطيبة يبقى أثرها فى النفوس و تذكر بخير و الكلمة الخبيثة يبقى اثرها و تذكر بشر مهما حاولنا و مهما اختفينا وراء الكلمات فهى تفضح مكنون النفوس فتخير كلماتك أخى الكريم و أحسن عرض أسلوبك لمسئلتك و انتقى من الخطوط ما يسر القلب و ما يريح العين ... ان كان كلامى خير فمن الله و فضله و ان كان كلامى شر فمن نفسى و أستغفر الله لى و لكم دمتم بخير جميعا و أعزكم الله

أخي الحبيب علاء بدلاً من استخدام جدول للنوع يمكن تعديل المعادلة لتؤدي الغرض بهذا الشكل بدون الاستعانة بجدول =VLOOKUP(A2,{"ذكر","ي";"أنثى","ت"},2,0)&IF(H2>=16,"وجه",IF(AND(G2>=10,H2<16),"نتقل","عيد السنة"))

تم تعديل الملف كي يعمل فقط على المعادلات اختر فقط من القائمة المنسدلة رقم السيارة و اكسل يقوم بالباقي اضغط اعجبني او افضل اجابة اذا كان كذلك المخالفات.zip

عموماً إليك الكود التالي عله يفي بالغرض إن شاء المولى Sub Test() Dim Coll As New Collection, ArrSheet, ArrTemp, ArrHolder, ArrOut1, ArrOut2 Dim I As Long, J As Long, P As Long, P1 As Long, P2 As Long, Str1 As String ArrSheet = Array(Sheets("مباع"), Sheets("مفعل"), Sheets("active"), Sheets("راجع")) ReDim ArrHolder(1 To Rows.Count, 1 To (UBound(ArrSheet) + 2)) ReDim ArrOut1(1 To Rows.Count, 1 To 1) ReDim ArrOut2(1 To Rows.Count, 1 To 1) For J = LBound(ArrSheet) To UBound(ArrSheet) ArrTemp = ArrSheet(J).Range("A2").CurrentRegion.Columns(1).Value On Error Resume Next For I = 1 To UBound(ArrTemp, 1) Str1 = CStr(ArrTemp(I, 1)) Coll.Add Key:=Str1, Item:=Coll.Count + 1 P = Coll(Str1) ArrHolder(P, 1) = ArrTemp(I, 1) ArrHolder(P, J + 2) = ArrHolder(P, J + 2) + 1 Next I On Error GoTo 0 Next J For I = 1 To Coll.Count P = 0 For J = 2 To UBound(ArrHolder, 2) P = P + Sgn(ArrHolder(I, J)) Next J If (P = UBound(ArrSheet) + 1) Then P1 = P1 + 1 ArrOut1(P1, 1) = ArrHolder(I, 1) Else P2 = P2 + 1 ArrOut2(P2, 1) = ArrHolder(I, 1) End If Next I With Sheets("النتيجة المطلوبة") .Range("A2").Resize(P1).Value = ArrOut1 .Range("B2").Resize(P2).Value = ArrOut2 End With End Sub سيتم استخراج الأرقام المتشابهة في كل أوراق العمل الأربعة معاً في العمود الأول أما الأرقام التي لم تحقق الشرط ستكون في العمود الثاني في ورقة العمل الأخيرة لا تنسى أن تحدد أفضل إجابة وأن تضغط على كلمة "أعجبني هذا" في حالة أن أعجبك الحل تقبل تحياتي Similar Data In Multi Sheets YasserKhalil.rar

الاستاذ يوسف يستخدم اوفيس 2013 الخلل موجود في المكتبات واخص مكتبة البريد Outlook يمكنك استبدالها بالاصدار الاقدم

الأخ الفاضل أبو إلياس إليك الكود بعد التصحيح .. من الأخطاء الظاهرة الخفية في الكود الذي قمت بكتابته كتابة رقم 1 بدلاً من حرف L في جملة xlup ويرجع ذلك إلى أنه عند كتابة حرف الـ L صغير بهذا الشكل l فإنه يشبه إلى حد كبير رقم 1 في محرر الأكواد .. وكذلك رقم 1 بدلاً من المتغير i يراعى عند كتابة الأكواد الدقة التااااااااامة ثم الدقة التامة .. التصحيح أصعب عندي من بناء الكود !! استغرق الأمر مني حوالي نصف ساعة لمعرفة الخطأ .. ظللت أنظر للكود ثم أنظر مرة أخرى ثم أنظر ولم ألاحظ أن حرف الـ L قد كتب بدلاً منه رقم 1 عموماً الحمد لله تم تدارك الخطأ .. ومعرفة مكمن المشكلة إليك الكود بعد التعديل Private Sub CommandButton1_Click() Dim MySH As Worksheet Dim I As Long, K As Long, R As Long, LR As Long Set MySH = Sheets("البيانات") K = 1 Columns("A:J").ClearContents For I = 3 To MySH.Cells(Rows.Count, 1).End(xlUp).Row LR = Cells(Rows.Count, 1).End(xlUp).Row + 1 For R = 1 To 10 If Me.Controls("CheckBox" & R) Then Cells(LR, K) = MySH.Cells(I, Me.Controls("CheckBox" & R).Caption) K = K + 1 End If Next R K = 1 Next I Unload Me End Sub لا تنسى أن تحدد أفضل إجابة .. كما لا تنسى أن تضغط على كلمة "أعجبني هذا" تقبل تحياتي :fff: Transfer Specific Columns By CheckBoxes On UserForm.rar

إبداع كالعادة سلمت يداك وبارك الله في علمك وأعطاك علما من عنده

اصبر واسمعني لو سمحت: مرة واحد عربي تزوج زوجة جديدة على زوجته الاولى, وكانت الاولى لما تمر على الجديدة تقول: نقل فؤادك حيث شئت من الهوى...مالحب الا للحبيب الاولِ كم منزل في الارض يألفه الفتى...وحنينه ابدا لأول منزلِ فترد الثانية وتقول: وما يستوي الثوبان ثوب به البلى...وثوب بايدي البائعين جديدُ والخيار لك ياسيدي أن تبقى على زوجتك الاولى او الثانية. عفوا اقصد اوفسك الاول او اوفسك الثاني.. مملة الحكاية صح!!!!

الأخ الفاضل سلام الله عليكم شاهد المرفق وهو مشاركة سابقة لأحد الزملاء الأفاضل تحياتى *** جمال دغيدى ** منع فتح الملف إذا تم نقله أو تغيير إسمه ومنع حفظه بإسم جديد.rar