عبدالفتاح في بي اكسيل

على حسب ما فهمت تريد العمل على ورقة العمل اثناء فتح اليوزرفورم اذا كان كذلك تحتاج الى هذا السطر من الكود UserForm1.Show 0

اعتقد انه بالفلترة افضل من الحلقات التكرارية Sub cutpaste_Rows() Application.ScreenUpdating = False Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set srcWS = Sheets("sheet1") Set desWS = Sheets("sheet2") With srcWS .Cells(6, 1).CurrentRegion.AutoFilter 3, Range("a2").Value .AutoFilter.Range.Offset(1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1) .AutoFilter.Range.Offset(1).EntireRow.Delete .Range("A1").AutoFilter End With Application.ScreenUpdating = True End Sub تلوين (1).xlsm

اخ محمد بخصوص هذ الخطا لديك زر تحكم لهم نفس الاسم عليك تغييره

ارفق ملف حتى تجد تفاعل من الاعضاء

في هذه الحالة يجب التاكد من تسمية الاوراق كما في الكود كما وضحلك الاخ حسين

الاكسيل لا يفتح اذا ادخلت الرقم السري خطا اليس هذا ما تريده

تفضل بيانات وصور الموظفين.rar

اخي الكريم لم تحدد ماذا يظهر لك بعد الدخول تدخل بشكل طبيعي لورقة الاكسيل

جرب هذا الملف لعله يفيدك هذه معادلة مصفوفة =IFERROR(INDEX($A$2:$A$9;SMALL(IF($F$2=TRIM($A$2:$A$9);ROW($A$2:$A$9)-MIN(ROW($A$2:$A$9))+1;"");ROW(A1)));"") اضغط على CTRL+SHIFT+ENTER بحث.xlsx

جربي هذا الماكرو لعله ينفع معك Sub PrintPreview() Dim ws As Worksheet Dim lastRow As Long Set ws = ThisWorkbook.Sheets("sheet1") lastRow = Cells(Rows.Count, 1).End(xlUp).Row ws.PageSetup.PrintArea = ws.Range("A1:g" & lastRow).Address ActiveSheet.PrintPreview End Sub

بالنسبة لهذين السطرين يعملان معي جرب وضع السطر الاول في بداية كود الترحيل sheet1.Unprotect pwd اما السطر الثاني في نهاية كود الترحيل sheet1.Protect pwd مع مراعاة اسم الورقة

جرب هذا الماكرو Sub extractmonth_name() Dim i As Long For i = 4 To 115 Cells(i, 5).Value = Month(Cells(i, 2).Value) Next i End Sub 5.xlsm

لماذا لا تجعل المدى من c2:c5جرب هذا التعديل MOKHTAR.Range("c2:c5,d5,g1,g2").Copy

يمكن الاستعانة بهذه المعادلة =IF(COUNTIF(A4:A10; F4:F10 );"";F4:F10) ملف الاسم.xlsx

انا اعمل على نظام ويندوز 10 64 بت الكود يظهر الفورم لفترة وجيزة ثم يختفي يعمل ولا مشكلة معي

ولماذا تشق على نفسك اعتقد الماكرو افضل بكثير من المعادلات

اعتقد تريد التخلص من الخلايا الفارغة بين الارقام على حسب ما فهمت تفضل هذه المعادلة =IFERROR(INDEX($L$1:$L$32;AGGREGATE(15;6;(ROW($L$1:$L$32)-ROW($L$1)+1)/($L$1:$L$32<>"");ROWS(I$2:I2)));"") filter (1).xlsx

في هذه الحالة جرب هذا الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) Range("J23").MergeArea = Application.WorksheetFunction.Sum(Application.ActiveWindow.RangeSelection) End Sub نموذج استلام اجهزة (1).xlsm

جرب هذا الماكرو وجب عليك تحديد المدى في العمود A الذي تحتاج لترقيمه Sub autonumber_MergedCells() Dim serial As Range, autonumber As Long Set serial = Selection(1) autonumber = 1 Do While Not Intersect(serial, Selection) Is Nothing serial.Value = autonumber autonumber = autonumber + 1 Set serial = serial.MergeArea.Offset(1) Loop End Sub

اضغط على OK لترى اين المؤشر يقف اذا وقف عند الفاصلة فعليك باستبدالها ; لاختلاف اصدرات الاوفيس

على حسب ما فهمت اعتقد هذا ما تريدة جرب هذه المعادلة =IF(SUMPRODUCT((E2:Q2=A2)*(1));A2;"") المصنف1.xlsx

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

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 5 And Target.Column = 1 Then If Target.Value = "" Then Sheet1.ShowAllData Else Sheet1.Cells.AutoFilter Field:=5, Criteria1:=Target.Value End If End If End Sub مشروع1.xlsm

اخت يارا اقترح عليك ان تقومي بهذه الخطوات 1- من المفترض أن تمر عبر الكود باستخدام المفتاح F8 أو (أفضل) لتعيين نقطة توقف على السطر السفلي الثاني (المؤشر في Next c متبوعًا بالضغط على المفتاح F9 ، متبوعًا بالضغط على المفتاح F5) 2- تصوير مراحل تطبيق الكود واعطائي النتيجة النهائية لاخر صورة حتى يتسنى معرفة كيفية المعالجة

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