Ali Mohamed Ali

بارك الله فيك استاذ أحمد

وعليكم السلام -طبعا اخى الكريم فى ملف اكسيل

وعليكم السلام-حاول استخدام هذا الكود Sub ProtectAll() Dim wBk As Workbook Dim sFileSpec As String Dim sPathSpec As String Dim sFoundFile As String sPathSpec = "C:\MyPath\" sFileSpec = "*.xls" sFoundFile = Dir(sPathSpec & sFileSpec) Do While sFoundFile <> "" Set wBk = Workbooks.Open(sPathSpec & sFoundFile) With wBk Application.DisplayAlerts = False wBk.SaveAs FileName:=.FullName, _ Password:="swordfish" Application.DisplayAlerts = True End With Set wBk = Nothing Workbooks(sFoundFile).Close False sFoundFile = Dir Loop End Sub أو جرب هذا Add password to all Excel workbook in folder او تلك Lock a Folder – In Windows – Excel Folder Lock Code أو هذا How to protect all workbooks in a folder at once in Excel?

بارك الله فيك أخى الكريم ونوت المنتدى

أحسنت استاذ سليم دائما مبدع -بارك الله فيك وزادك الله من فضله ووسع الله فى رزقك

جزاك الله كل خير وزادك الله من فضله

جزاك الله خير الثواب

تفضل بعد اذن الأستاذ فايز problem sum if green erorr2.xls

تفضل لك ما طلبت Data.xlsm

بارك الله فيك وزادك الله من فضله

تفضل اخى الكريم فمثلا هذه هى معادلة جلب اسم الموظف من رقمه =INDEX(staff!$B$3:$B$7,MATCH(C1,staff!$A$3:$A$7,0)) اول جزء من المعادلة وهو Index لابد ان يأتى بعدها عمود البيانات المطلوبة , وبما ان عمود اسماء الموظفين الموجود بصفحة Staff هو العمود الثانى أى عمود B ويبدأ من الخلية B3 ..فاصبح نطاق هذا العمود من B3:B7 او الى اخر خلية تريدها وبها بيانات فممكن الى B500 فليس هناك مشكلة فى هذا أما بالنسبة للجزء الثانى من المعادلة بعد وضع هذه العلامة , أو المنقوطة ; حسب اعدادات الكمبيوتر لديك فهناك باقى شرط المعادلة لإيجاد الناتج وهو Match ثم بعد القوس يتم وضع رقم الخلية للبند ان نبحث به وهو رقم الموظف بصفحة Info وتكون فى المعادلة C1 ثم يتم وضع فاصة , وبعد ذلك يوضع نطاق عمود أرقام الموظفين من الصفحة الأخرى Staff ويكون العمود الأول A وكما اتفقنا يبدأ نطاق الجدول من الصف الثالث فتكون A3 : A500 مثلا ثم بعد ذلك وضع فاصة كمان , ثم الرقم 0 صفر وبعد ذلك غلق قوسين الأول لـ Match والثانى يخص جزء Index وبكده تكون انتهت المعادلة بارك الله فيك

تفضل لك ما طلبت Data Entry.xlsm

أحسنت أستاذ عبد اللطيف عمل رائع بارك الله فيك

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

بارك الله فيك هدية بالطبع مقبولة ,جزاك الله خير الثواب

وعليكم السلام-لك ما طلبت على الرغم ان هذا الموضوع تكرر مئات المرات فى المنتدى فعليك بعد ذلك استخدام خاصية البحث بالمنتدى قبل رفع المشاركة فالمنتدى به كنــــوز id emplloy1.xlsx

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

بارك الله فيك وزادك الله من فضله ورحم الله والديك

وعليكم السلام-يمكنك تطويع هذا الكود Option Explicit Option Base 1 Sub Wsh_CopyTo_NewWbk() Dim aWsh As Variant aWsh = [{"Sheet1","Wsh1";"Sheet2","Wsh2"}] Dim aWshSrc(2) As Worksheet Dim wbk As Workbook, wsh As Worksheet Dim vItm As Variant, b As Byte Rem Set Worksheet Array With ThisWorkbook For b = 1 To UBound(aWsh) .Worksheets(aWsh(b, 1)).Unprotect Password:=aWsh(b, 2) Set aWshSrc(b) = .Worksheets(aWsh(b, 1)) Next: End With Rem Add New Workbook Set wbk = Workbooks.Add With wbk Rem Delete All Worksheets but One Application.DisplayAlerts = False For Each wsh In .Worksheets With wsh If .Index = 1 Then .Name = "!DELETE" Else .Delete End With: Next Application.DisplayAlerts = True Rem Copy Worksheets For Each vItm In aWshSrc vItm.Copy After:=Sheets(.Sheets.Count) Set wsh = .Sheets(.Sheets.Count) wsh.UsedRange.Value = wsh.UsedRange.Value2 Next Rem Delete Reamining Worksheet Application.DisplayAlerts = False .Worksheets("!DELETE").Delete Application.DisplayAlerts = True End With End Sub

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

بارك الله فيك وزادك الله من فضله

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

تفضل تم وضع كود الأستاذ ابراهيم بملفك وربطه بالزر 111.xlsm

وعليكم السلام-لك ما طلبت 1مرتب.xlsx

وعليكم السلام-تفضل لك ما طلبت طرح تاريخ.xlsm