أكاديمية الصقر للتدريب

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


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





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

يعطيكم العافيه مرفق لكم جدول فيه ورقتين اتمني ان يتم ترحيل البيانات من الورقه 1 الي الورقه2 وذلك حسب الشرط اللي امام ك ..


موضوع مغلق


01-10-2021 08:09 مساء
asd2000
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-03-2020
رقم العضوية : 18379
المشاركات : 36
الجنس : ذكر
تاريخ الميلاد : 19-1-1980
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 18
 offline 

يعطيكم العافيه 



مرفق لكم جدول فيه ورقتين اتمني ان يتم ترحيل البيانات من الورقه 1 الي الورقه2 وذلك حسب الشرط اللي امام كل صف  مرفق لكم الحل المطلوب في المرفق



وبعد الترحيل تحذف البيانات المرحله في الورقه 1

 
 
  ع.xlsx   تحميل xlsx مرات التحميل :(12)
الحجم :(12.117) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Const sCrit As String = "جاهز"
    Dim ws As Worksheet, sh As Worksheet, lr As Long, n As Long, x As Long, r As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets(1)
        Set sh = ThisWorkbook.Worksheets(2)
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        n = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        If n = 2 Then n = n + 1
        x = Application.CountIf(ws.Range("I3:I" & lr), sCrit)
        If x = 0 Then MsgBox "No Data To Transfer", vbExclamation: Exit Sub
        For r = 3 To lr
            If ws.Cells(r, 9).Value = sCrit Then
                sh.Range("A" & n).Resize(1, 9).Value = ws.Range("A" & r).Resize(1, 9).Value
                n = n + 1
            End If
        Next r
        For r = lr To 3 Step -1
            If ws.Cells(r, 9).Value = sCrit Then
                ws.Rows(r).Delete
            End If
        Next r
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub
عرض الإجابة




02-10-2021 06:49 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif ترحيل البيانات ومسحها حسب الشرط
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Const sCrit As String = "جاهز"
    Dim ws As Worksheet, sh As Worksheet, lr As Long, n As Long, x As Long, r As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets(1)
        Set sh = ThisWorkbook.Worksheets(2)
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        n = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        If n = 2 Then n = n + 1
        x = Application.CountIf(ws.Range("I3:I" & lr), sCrit)
        If x = 0 Then MsgBox "No Data To Transfer", vbExclamation: Exit Sub
        For r = 3 To lr
            If ws.Cells(r, 9).Value = sCrit Then
                sh.Range("A" & n).Resize(1, 9).Value = ws.Range("A" & r).Resize(1, 9).Value
                n = n + 1
            End If
        Next r
        For r = lr To 3 Step -1
            If ws.Cells(r, 9).Value = sCrit Then
                ws.Rows(r).Delete
            End If
        Next r
    Application.ScreenUpdating = True
    MsgBox "Done...", 64
End Sub

02-10-2021 07:58 مساء
مشاهدة مشاركة منفردة [2]
asd2000
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 04-03-2020
رقم العضوية : 18379
المشاركات : 36
الجنس : ذكر
تاريخ الميلاد : 19-1-1980
يتابعهم : 2
يتابعونه : 0
قوة السمعة : 18
 offline 
look/images/icons/i1.gif ترحيل البيانات ومسحها حسب الشرط
الاستاذ ياسر 
كلمة مبدع والله قليله جدا جدا
كود بكل ما اتمناه بدون اخطا
اشكرك جدا

03-10-2021 07:28 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif ترحيل البيانات ومسحها حسب الشرط
بارك الله فيك أخي الكريم ومشكور على كلماتك الطيبة
والحمد لله الذي بنعمته تتم الصالحات.



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


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 07:35 مساء