محمد عبد الناصر

ماشاء الله استاذ محمد صالح و استاذ محمد هاشم جعله الله في ميزان حسناتكم

هذا الكود يقوم بربط الشيتات ب Sheet1 اريد ان يقوم بعمل الكود وان لا ينفذ الامر على sheet2 و sheet7 و sheet3 وان يجعل حجم الخط في الخليه E1 في كل الشيتات 30 Sub ww() Dim h As Worksheet, sh As Worksheet, j As String Dim k As String, x As String, d As String Set h = Sheets("Sheet1") For Each sh In Sheets If Not sh.Name = "Sheet1" Then j = sh.Index + 2 k = sh.Name x = "'" & k & "'!a1" d = "'Sheet1'!a1" h.Hyperlinks.Add h.Cells(j, 1), "", x, k, k sh.Hyperlinks.Add sh.Cells(1, 5), "", d, "Sheet1", "رجوع" End If Next End Sub

لو امكن ممكن تطبقهالي على الملف المرفق ؟؟ لما بحط المعادلة بيجبلي خطأ

السلام عليكم ورحمة الله وبركاته ,,, في الملف المرفق بيانات لموظفين لدي من سنة 2022 الى سنة 2023 يوجد من الموظفين من ترك الشركة ومن مستمر معي وموظفين جدد اريد الفصل بينهم في كل شيت خاص بالحاله ومطلوب كود اخر يقوم بتحديد الموظفين الذي تم زيادة رواتبهم والذي لم يتم زيادة رواتبهم في شيت المعدل الملف المرفق موضح المطلوب شكرا لكل من ساعدني جعله الله في موازين حسناتكم OK.xlsm

ماشاء الله هو المطلوب تمام جزاك الله كل خير

ماشاء الله استاذ محمد هاشم بارك الله فيك وفي علمك وجعله الله في ميزان حسناتك ولكن لماذا يقوم بمسح اي شيت اخر موجود فمثلا يقوم بمسح sheet2 وهو غير مكتوب في العمود C لا اريد ان يتم مسح اي شيت اخر عند تفعيل الكود

السلام عليكم ورحمة الله وبركاته,,, في ها الكود يقوم بفتح عدة شيتات على حسب الاسم المكتوب في العمود C في كل خليه به المطلوب ان يقوم بنسخ البيانات وترحيلها الى الشيت المخصص لها حسب المكتوب في العمود C فمثلا في الخلية C4 مكتوب كنوز فيقوم بنسخ الصف الى شيت كنوز الخليه C5 مكتوب ادعية يقوم بنسخ الصف الى شيت ادعية ومطلوب ان يجعل العمود B في كل الشيتات size 70 ويقوم ايضا بنسخ الصف 5 ويضعه في كل الشيتات في الصف رقم 5 الملف المرفق يوضح المطلوب ..... وجزاكم الله كل خير على مساعدتكم Sub CreateSheets() Dim lra As Integer Dim My_Rg As Range Dim ListSh As Range lra = Cells(Rows.Count, "c").End(xlUp).Row Set ListSh = Worksheets("Sheet1").Range("c6:h" & lra) On Error Resume Next For Each My_Rg In ListSh If Len(Trim(My_Rg.Value)) > 0 Then If Len(Worksheets(My_Rg.Value).Name) = 0 Then Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = My_Rg.Value End If End If Worksheets("Sheet1").Select Next My_Rg Applications.Calculations = xlCalculationManual End Sub اسلاميات.xlsm

السلام عليكم ورحمة الله وبركاته مطلوب كود ييقوم بنقل اصفف حسب المكتوب في الخليه a1 في العمود E ويقوم بفتح شيت مخصص حسب الاسم المكتوب في العمود A3:A20000 الملف المرفق موضح الطلوب MD.xlsm

السلام عليكم ورحمة الله وبركاته,,,, اريد ملف اكسيل به جميع عملات العالم مقابل الجنيه المصري

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

السلام عليكم ورحمة الله وبركاته مطلوب تعديل في هذا الكود في بداية الامر يقوم بفتح حماية جميع الشيتات بباسورد وفي نهاية الكود يقوم بقفل جميع الشيتات بباسورد محدد Sub go_mod5alat() If Sheets("ÇáãÏÎáÇÊ").Range("c6") = "" Then MsgBox "ÏÎá ÇÓÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜã ÇáÚãããããíííííííííííííííííííááááááá", vbExclamation: Exit Sub Sheets("ÝÇÊæÑÉ ãÏÎáÇÊ").PrintOut Dim ws As Worksheet, Data As Worksheet, ShName As String Dim LR As Long, ER As Long, x As Integer Set Data = Sheets("ÇáãÏÎáÇÊ") ShName = Data.Range("C6").Text ER = Data.Range("B" & Rows.Count).End(3).Row x = ER - 7 For Each ws In Worksheets If ws.Name = ShName Then LR = ws.Range("B" & Rows.Count).End(3).Row ws.Name = ShName ws.Range("B" & LR + 1).Resize(x, 17) = Data.Range("B10").Resize(x, 17).Value End If Next Sheets("ÇáãÏÎáÇÊ").Protect Password:="20125907275" Sheets("sheet1").Unprotect Password:="20125907275" Dim strName As String, sh As Worksheet strName = Trim(Sheet4.Range("am14").Value) For Each sh In Worksheets If sh.Name = strName Then Exit Sub Next sh Sheet4.Copy after:=Sheets(Sheets.Count) Sheets("sheet1 (2)").Name = strName With Sheets(strName) .Shapes("Button 1").Delete With .Range("b10:am10000") .Value = .Value End With Sheets("ÇáãÏÎáÇÊ").Range("B10:B1000").ClearContents Sheets("ÇáãÏÎáÇÊ").Range("d10:d1000").ClearContents Sheets("ÇáãÏÎáÇÊ").Range("h10:h1000").ClearContents Sheets("ÇáãÏÎáÇÊ").Range("n10:n1000").ClearContents Sheets("ÇáãÏÎáÇÊ").Range("c6").ClearContents Sheets("ÇáãÏÎáÇÊ").Protect Password:="20125907275" Sheets("ÇáãÏÎáÇÊ").Select Range("A1").Select ActiveWorkbook.Save End Sub

ماشاء الله اخي الكريم هو المطلوب تمام شكرا لك وبارك الله لك

السلام عليكم ورحمة الله وبركاته هل من طريقة او كود يقوم باخفاء مسميات الاعمدة مثل A B C D والصفوف مثل 1 2 3 4

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

السلام عليكم ورحمة الله وبركاته هذا الكود يقوم بتفح ورقة جديدة على حسب المكتوب في AM14 المطلوب ان يقوم بقفل و حماية هذه الورقة الذي يقوم بفتحها لعدم العبث او تخريب البيانات بها Sub CopySheet() Dim strName As String, Sh As Worksheet strName = Trim(Sheet4.Range("am14").Value) For Each Sh In Worksheets If Sh.Name = strName Then Exit Sub Next Sh Sheet4.Copy after:=Sheets(Sheets.Count) Sheets("sheet1 (2)").Name = strName With Sheets(strName) .Shapes("Button 1").Delete With .Range("b10:am1009") .Value = .Value End With End With Sheets("الشاشة الرئيسية").Select Range("A1").Select End Sub