اذهب الي المحتوي
أوفيسنا

مختار حسين محمود

الخبراء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    944

  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    10

 نوع المحتوي 

مشاركات المكتوبه بواسطه مختار حسين محمود

    نسخ بيانات من صفحة لعدة صفحات بشرط

    في منتدى الاكسيل Excel

    قام بنشر

    13 دقائق مضت, ياسر خليل أبو البراء said:

    لا يحبذ استخدام Select و Activate في كتابة الكود إذ أنه يسبب بطء في التنفيذ

    أدرك ذلك ولكن

    بدون السطر ده  الكود لن يعمل الا على الورقة الاولى فقط

    و السطر التالى له مع الحلقة التكرارية يستلزم  بالضرورة  تنشيط الأوراق ورقة ورقة لاتمام الحلقة التكرارية

    وهو فيه أكيد طرق أخرى لكن أخى معلم ابتدائى أخد منى  النهردة  كل تركيزى الله يبارك له :biggrin:

     

    • Like 1

    نسخ بيانات من صفحة لعدة صفحات بشرط

    في منتدى الاكسيل Excel

    قام بنشر

    ضع الكود التالى فى مديول جديد 

    الكود لمسح النطاق من الخلية a4 الى آخر خلية فى العمود j  فى كل الاوراق  

    و أؤكد مرة أخرى لابد من تتطاق جميع الأورارق 

    Option Explicit

Sub delallData()
Dim ws As Worksheet
On Error Resume Next
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
     With ws
       .Activate
       .Range(Cells(4, "A"), Cells(Rows.Count, "J")).ClearContents
     End With
Next ws
On Error GoTo 0
Sheets("data").Activate
Application.ScreenUpdating = True

End Sub

    تحياتى

    • Like 1

    نسخ بيانات من صفحة لعدة صفحات بشرط

    في منتدى الاكسيل Excel

    قام بنشر 

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

With Application
            .ScreenUpdating = False
           .DisplayAlerts = False
End With
   
If Target.Column <> 3 Then Exit Sub
    
    Select Case Target.Value
    
    Case Is = 1
        Target.Offset(0, -1).Resize(, 7).Copy
        With Sheets("c1").Range("B1000").End(xlUp).Offset(1, 0)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteColumnWidths
        End With
        
    Case Is = 2
        Target.Offset(0, -1).Resize(, 7).Copy
        With Sheets("c2").Range("B1000").End(xlUp).Offset(1, 0)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteColumnWidths
        End With
        
    Case Is = 3
        Target.Offset(0, -1).Resize(, 7).Copy
        With Sheets("c3").Range("B1000").End(xlUp).Offset(1, 0)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteColumnWidths
        End With
    
    Case Is = 4
    Target.Offset(0, -1).Resize(, 7).Copy
        With Sheets("c4").Range("B1000").End(xlUp).Offset(1, 0)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteColumnWidths
        End With
    
       
     Case Is = 5
         Target.Offset(0, -1).Resize(, 7).Copy
        With Sheets("c5").Range("B1000").End(xlUp).Offset(1, 0)
             .PasteSpecial xlPasteValues
             .PasteSpecial xlPasteColumnWidths
        End With
        
    End Select

   With Application
            .CutCopyMode = False
            .ScreenUpdating = True
           .DisplayAlerts = True
   End With

End Sub

    ده عشان الطلب الاول نسخ القيم وعرض الأعمدة فقط

    الطلب التانى  عايز  تمسح  العمود C   وكل البيانات فى كل الأوراق  مش كده ولا تقصد حاجة تانى ؟

     

    نسخ بيانات من صفحة لعدة صفحات بشرط

    في منتدى الاكسيل Excel

    قام بنشر

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

    
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Target.Column <> 3 Then Exit Sub
    
    Select Case Target.Value
    
    Case Is = 1
        Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الاول").Range("B1000").End(xlUp).Offset(1, 0)
    
    Case Is = 2
        Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الثانى").Range("B1000").End(xlUp).Offset(1, 0)
          
    Case Is = 3
        Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الثالث").Range("B1000").End(xlUp).Offset(1, 0)
    
    Case Is = 4
    Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الرابع").Range("B1000").End(xlUp).Offset(1, 0)
        Target.EntireRow.Copy Sheets("الصف الرابع").Range("A1000").End(xlUp).Offset(1, 0)
       
     Case Is = 5
         Target.Offset(0, -1).Resize(, 7).Copy Sheets("الصف الخامس").Range("B1000").End(xlUp).Offset(1, 0)
      
    End Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

     

    • Like 1

    نسخ بيانات من صفحة لعدة صفحات بشرط

    في منتدى الاكسيل Excel

    قام بنشر 

    
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

If Target.Column <> 3 Then Exit Sub
    
    Select Case Target.Value
    
    Case Is = 1
        Target.EntireRow.Copy Sheets("الصف الاول").Range("A1000").End(xlUp).Offset(1, 0)
    
    Case Is = 2
        Target.EntireRow.Copy Sheets("الصف الثانى").Range("A1000").End(xlUp).Offset(1, 0)
       
    
    Case Is = 3
        Target.EntireRow.Copy Sheets("الصف الثالث").Range("A1000").End(xlUp).Offset(1, 0)
       
    Case Is = 4
        Target.EntireRow.Copy Sheets("الصف الرابع").Range("A1000").End(xlUp).Offset(1, 0)
       
     Case Is = 5
        Target.EntireRow.Copy Sheets("الصف الخامس").Range("A1000").End(xlUp).Offset(1, 0)
       
    
    End Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

    بعد اذن الاستاذ سليم   هذه الاضافة

    أخى الكريم ضع الكود التالى فى حدث الورقة  بمجرد ادخال رقم الصف فى العمود c يتم الترحيل مباشرة

     

     

    • Like 1

    استدعاء فورم عن طريق رقم سري

    في منتدى الاكسيل Excel

    قام بنشر 

    Sub ShowUF()
    Dim strPass As String
    Dim LCount As Integer

    For LCount = 1 To 3
        strPass = InputBox(Prompt:="الرجاء إدخال كلمة المرور", Title:="كلمة المرور")
        If strPass = vbNullString Then
            Exit Sub
        ElseIf strPass <> "123" Then
            MsgBox "كلمة المرور غير صحيحة", vbCritical, "التأكد من كلمة المرور"
        Else
            UserForm1.Show
            Exit For
        End If
    Next LCount
    
    If LCount = 4 Then Exit Sub
End Sub

    تحياتى أخى رجب بارك الله فيكم

    أخى محمد وجرب الكود السابق كمان 

     

     

     

    • Like 1

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

    في منتدى الاكسيل Excel

    قام بنشر

    أخى ياسر  بارك الله فيك وجزاك خيرا

    الى كل الأخوة بالمنتدى رجاء

    لابد من ارفاق ملف للعمل عليه لنتجنب البعد عن الفرضيات والتخمينات

    تحديث الأوفيس لديكم على الأقل  2010 للحصول على أفضل الامكانات فى الأوفيس وحتى لا تحدث لدينا مثل هذه الاشكاليات ونوفر وقتنا وجهدنا

    وشخصيا أعجبنى الكود الأول  لأنه أبسط  و أسهل

    وأستاذن أستاذى ياسر فى هذه الصورة الجديدة للكود :

    تم الاستغناء عن الدالة GetCellColorForReals   و الرقم  65535  الذى يمثل اللون الأصفر  والتعويض عنه بـ ColorIndex = 6 

    Option Explicit
Sub CountCellsByColorIndex()
    Dim Ws As Worksheet, Cel As Range, i As Integer
    Application.ScreenUpdating = False
        For Each Ws In ThisWorkbook.Worksheets
            For Each Cel In Ws.Range("I7:I" & Ws.Cells(Rows.Count, "I").End(xlUp).Row)
                 If Cel.DisplayFormat.Interior.ColorIndex = 6 Then i = i + 1  ' ColorIndex =6 هو اللون الأصفر
            Next Cel
        Next Ws
        If i = 0 Then
            MsgBox "لا يوجد خلايا ملونة ", 64
        Else
            MsgBox "عدد الخلايا الملونة يساوي " & i
        End If
    Application.ScreenUpdating = True
End Sub

     

    تحياتى

    • Like 1

    الترحيل حسب اكثر من شرط لاسماء اوراق العمل المطابقة للشرط

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه مختار حسين محمود

    أستاذى الفاضل رجب

    كود رائع بارك الله فيك

    ملحوظة صغيرة و ليس تعديلا  : 

    كما قال أخونا وأستاذنا ياسر خليل لا تنسى الاعلان عن كل المتغيرات فى أكوادك

    اجعل السطر التالى :     Option Explicit  على رأس أكوادك فهو لن يتركك الا اذا أعلنت عن كل المتغيرات و كفيل  بتذكيرك بذلك

    تحياتى

     

    • Like 1

    مهم للغايه ارجو الاطلاع (لعدم تكرار الموضوع عند إنشائه)

    في منتدى الاكسيل Excel

    قام بنشر

    السلام عليكم

    أخى أحمد الفلاحجى  بارك الله فيك

     

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

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

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

    لا أتراجع وانما بدخل الموقع من جديد حتى لا يتكرر الموضوع   تحياتى

     

    • Like 1

    تشغيل آلى لكود إذا ترك ملف الاكسل بدون استخدام

    في منتدى الاكسيل Excel

    قام بنشر · تم تعديل بواسطه مختار حسين محمود

    أخى الغالى الشقى الغلاباوى مشرفنا الجميل ياسر العربى حزاكم الله خيرا

    أخى و حبيبى فى الله حسام ميلكانا جزاكم  الله خيرا    أسعد بمرورك  دائما

    أستاذنا الكبير الخلوق رجب جاويش يعلم الله أن مرورك شرفنى و أسعدنى كثيرا

    أخى و حبيبى فى الله ياسر فتحى  الأروع مرورك الجميل و الرائع  مبروووووووووك الترقية

    أخى الغالى ومشرفنا الخلوق ابراهيم أبو ليله بارك الله فيك و جزاكم خيرا  أسعد بمرورك  دائما

     

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

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

    والاشراف مسئوليه كبيرة تتطلب متابعة مستمرة وهذا لا أقدر عليه

    و يعلم بعض أحبابى فى المنتدى  مثل أخى أبا البراء أننى آخذ كل فترة غطسا

    بعيدا عن المنتدى أبحث هنا وهناك عن كل غريب و فريد من البرامج والأكواد

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

    و مرة تانيه أشكرك أستاذى الفاضل محمد حسن على الثقة الغالية  

    لكم منى جميعا كل التحية و التقدير و الاحترام

    • Like 3

    تشغيل آلى لكود إذا ترك ملف الاكسل بدون استخدام

    في منتدى الاكسيل Excel

    قام بنشر

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

    أخى نايف
    مشكور على مرورك  وعلى حرصك على التطبيق

    بالنسبة للرسالة الظاهرة لك  : يظهر هذا النوع من الرسائل اذا كان فى الملف كودين يحملان نفس الاسم
    تأكد من أن الملف ليس فيه كود فى حدث الملف يبدأ بهذا الاسم :Private Sub Workbook_Open
    لان هذا الاسم يساوى Auto_Open    حاولت أمس أن أرد عليك لكن النت فصل امبارح  أثناء الرد

    لكن  و رانا مشرف و مراقب نشيط  هو حبيبنا فى الله ياسر خليل قام بالواجب وزيادة

    أخى احمد الفلاحجى
    مشكور على مرورك  وعلى حرصك على زيادة المعرفة

     

    • Like 1
×
×
  • اضف...

Important Information

  I accept