اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ترحيل البيانات التى يتم تحديدها فقط عن طريق ال Check Box


إذهب إلى أفضل إجابة Solved by ياسر خليل أبو البراء,

الردود الموصى بها

Daily sales follow-up report.xlsmالسلام عليكم ورحمة الله وبركاته

جمعة مباركة على جميع الزملاء والأساتذه الأفاضل 

بعد إذن أساتذتى الأفاضل 

مرفق شيت موضح به بيانات أريد كود يقوم بترحيل البيانات المحددة فقط عن طريق ال Check Box 

علما بأنه يتم تحديد ال Check Box يوما بعد الأخر عندما يتم التسليم مع مراعاة عدم تكرار المحدد والذى تم ترحلية من قبل عند تحديد بيانات أخرى جديدة 

ولسيادتكم خالص الشكر والتقدير

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

 

Daily sales follow-up report.xlsm

تم تعديل بواسطه Yasser Fathi Albanna
خطأ فى إرفاق الملف
  • Like 1
رابط هذا التعليق
شارك

  • أفضل إجابة

وعليكم السلام أخي الكريم ياسر

جرب الكود التالي عله يفي بالغرض بإذن الله

تم الاعتماد على العمود R في الورقة الثانية لتسجيل اسم Check Box الذي تم ترحيله تفادياً لترحيله مرة أخرى .. يمكنك إخفاء العمود أو إخفاء القيم في العمود R

Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, chkBox As CheckBox, r As Long, m As Long, cnt As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Sheets(1)
        Set sh = ThisWorkbook.Sheets(2)
        For r = 3 To ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
            Set chkBox = ws.Shapes("Check Box " & r - 2).OLEFormat.Object
            x = Application.Match(chkBox.Name, sh.Columns("R"), 0)
            If IsError(x) Then
                If chkBox.Value = 1 Then
                    m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
                    sh.Range("A" & m).Resize(, 17).Value = ws.Range("A" & r).Resize(, 17).Value
                    sh.Range("R" & m).Value = chkBox.Name
                    cnt = cnt + 1
                End If
            End If
        Next r
    Application.ScreenUpdating = True
    If cnt > 0 Then MsgBox "Total = " & cnt, 64 Else MsgBox "Nothing Transferred", vbExclamation
End Sub

 

  • Like 3
رابط هذا التعليق
شارك

أستاذ / ياسر خليل أبو البراء

أستاذى ومعلمى القدير

ألف شكر كود أكثر من رائع 

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

بالفعل كود أكثر من رائع وأوفى بالغرض المطلوب بالضبط

لا زلت أتعلم منك الكثير والكثير أستاذى الحبيب

  • Like 1
رابط هذا التعليق
شارك

إستفسار أستاذ / ياسر 

بعد إذن حضرتك

عند عمل حفظ يظهر هذه الرسالة

وهل يتم وضع الكود فى Sheet 1 أم يوضع فى Module

 

Untitled.png

تم تعديل بواسطه Yasser Fathi Albanna
  • Like 1
رابط هذا التعليق
شارك

مشكور أخي ياسر على كلماتك الطيبة ودعواتك الطيبة

والحمد لله الذي بنعمته تتم الصالحات

الكود ليس له علاقة بالرسالة .. يمكنك حل المشكلة بالشكل التالي

348982797.png

  • Like 3
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information