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

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

قام بنشر (معدل)

السلام عليكم ورحمة الله

 

دلوقتى عندى ملف اكسيل عباره عند عدد 2 شيت الشيت الاول فى اسماء موظفين عايز لو فى موظف جمب اسمو فى العمود D موجود رقم 1 السطر كولو يتنسخ فى الشيت رقم 2 انا شارح جوه الملف المرفق انا عايز ايه  ياريت الى يساعدنى يقولى عملها ازاى عشان عايز اطبقها على كذا ملف عندى وشكرااااااااااا

Book1.rar

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

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

إذا كان يفي بالغرض سأقوم إن شاء الله بشرحه لك

يرجى تغيير اسم الموضوع لعنوان يتعلق بالموضوع مثلا (نسخ صفوف في حالة تحقق شرط معين)

 

Transfer Rows.rar

قام بنشر

تفضل أخي الكريم شرح الكود

Sub CopyRows()
    'تعريف المتغيرات
    Dim LR As Long, I As Long, X As Long
    '[D]تحديد آخر صف به بيانات بالعمود
    LR = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
    'متغير يحمل القيمة 5 كبداية للصفوف المراد نسخ الصفوف إليها ، أي أن الرقم 5 هو صف البداية للنتائج
    X = 5
    'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
        'مسح الصفوف في ورقة النتائج بداية من الصف الخامس إلى الصف الألف
        Sheets("Sheet2").Rows("5:1000").ClearContents
        'وحتى آخر خلية بها بيانات لعمل شرط على قيمة الخلية[Sheet1]حلقة تكرارية بداية من الصف الرابع في ورقة العمل
        For I = 4 To LR
            'إذا كانت قيمة الخلية في العمود الرابع تساوي واحد
            'يقوم هذا السطر في حالة تحقق الشرط بنسخ الصف إلى ورقة النتائج في الصف الخامس كبداية
            'بمقدار 1 استعداداً لنسخ صف جديد في حالة تحقق الشرط[X]ثم بعد عملية النسخ واللصق يتم زيادة المتغير
            If Cells(I, "D").Value = 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1
        'الانتقال لصف جديد لعمل اللازم
        Next I
        'إلغاء خاصية النسخ واللصق
        Application.CutCopyMode = False
    'تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

لا تنسانا بدعوة بظهر الغيب

  • Like 2
قام بنشر

أخى الفاضل 

 

وبعد إذن أستاذي القدير أ.ياسر .. اجعل الكود هكذا بزيادة جملة واحدة فقط

Sub CopyRows()
    'تعريف المتغيرات
    Dim LR As Long, I As Long, X As Long
    '[D]تحديد آخر صف به بيانات بالعمود
    LR = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
    'متغير يحمل القيمة 5 كبداية للصفوف المراد نسخ الصفوف إليها ، أي أن الرقم 5 هو صف البداية للنتائج
    X = 5
    'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
        'مسح الصفوف في ورقة النتائج بداية من الصف الخامس إلى الصف الألف
        Sheets("Sheet2").Rows("5:1000").ClearContents
        'وحتى آخر خلية بها بيانات لعمل شرط على قيمة الخلية[Sheet1]حلقة تكرارية بداية من الصف الرابع في ورقة العمل
        For I = 4 To LR
            'إذا كانت قيمة الخلية في العمود الرابع تساوي واحد
            'يقوم هذا السطر في حالة تحقق الشرط بنسخ الصف إلى ورقة النتائج في الصف الخامس كبداية
            'بمقدار 1 استعداداً لنسخ صف جديد في حالة تحقق الشرط[X]ثم بعد عملية النسخ واللصق يتم زيادة المتغير
            If Cells(I, "D").Value = 1 OR Cells(I, "F").Value = 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1
        'الانتقال لصف جديد لعمل اللازم
        Next I
        'إلغاء خاصية النسخ واللصق
        Application.CutCopyMode = False
    'تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

تحياتي :fff: 

  • Like 1
قام بنشر

أخى الفاضل 

 

وبعد إذن أستاذي القدير أ.ياسر .. اجعل الكود هكذا بزيادة جملة واحدة فقط

Sub CopyRows()
    'تعريف المتغيرات
    Dim LR As Long, I As Long, X As Long
    '[D]تحديد آخر صف به بيانات بالعمود
    LR = Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
    'متغير يحمل القيمة 5 كبداية للصفوف المراد نسخ الصفوف إليها ، أي أن الرقم 5 هو صف البداية للنتائج
    X = 5
    'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
        'مسح الصفوف في ورقة النتائج بداية من الصف الخامس إلى الصف الألف
        Sheets("Sheet2").Rows("5:1000").ClearContents
        'وحتى آخر خلية بها بيانات لعمل شرط على قيمة الخلية[Sheet1]حلقة تكرارية بداية من الصف الرابع في ورقة العمل
        For I = 4 To LR
            'إذا كانت قيمة الخلية في العمود الرابع تساوي واحد
            'يقوم هذا السطر في حالة تحقق الشرط بنسخ الصف إلى ورقة النتائج في الصف الخامس كبداية
            'بمقدار 1 استعداداً لنسخ صف جديد في حالة تحقق الشرط[X]ثم بعد عملية النسخ واللصق يتم زيادة المتغير
            If Cells(I, "D").Value = 1 OR Cells(I, "F").Value = 1 Then Rows(I).Copy Sheets("Sheet2").Range("A" & X): X = X + 1
        'الانتقال لصف جديد لعمل اللازم
        Next I
        'إلغاء خاصية النسخ واللصق
        Application.CutCopyMode = False
    'تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

تحياتي :fff: 

 

معلش انا اسف انا على ادى فى الاكسيل ممكن حضرتك تعملهالى فى ملف عايز العمود D والعمود F لو اى واحد فى العمودين دول فيهم رقم 30 او اقل ربنا يجعلو فى ميزان حسناتك محتاج الملف اوى

 

قام بنشر

 

معلش انا اسف انا على ادى فى الاكسيل ممكن حضرتك تعملهالى فى ملف عايز العمود D والعمود F لو اى واحد فى العمودين دول فيهم رقم 30 او اقل ربنا يجعلو فى ميزان حسناتك محتاج الملف اوى

 

 

 

اخى الفاضل

 

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

 

تحياتي :fff: 

Transfer Rows.rar

قام بنشر

 

 

معلش انا اسف انا على ادى فى الاكسيل ممكن حضرتك تعملهالى فى ملف عايز العمود D والعمود F لو اى واحد فى العمودين دول فيهم رقم 30 او اقل ربنا يجعلو فى ميزان حسناتك محتاج الملف اوى

 

 

 

اخى الفاضل

 

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

 

تحياتي :fff: 

 

 

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

شكرا يا احلى منتدى

 

قام بنشر

الأخ الحبيب الغالي ابن مصر

لا حرمنا الله من وجودك ..فبك تكتمل فرحتنا وتنور المنتدى وتنور قلوبنا

بارك الله فيك ..

الأخ فؤاد ..

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

قام بنشر (معدل)

الأخ الحبيب الغالي ابن مصر

لا حرمنا الله من وجودك ..فبك تكتمل فرحتنا وتنور المنتدى وتنور قلوبنا

بارك الله فيك ..

الأخ فؤاد ..

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

 

ربنا يعزك يارب ويجعلو فى ميزان حسناتك انت و الاستاذ ( ابن مصر ) حضرتك ساعدتنى فى مواضيع كتير جداااا والف الف شكر ربنا يكرمك ان شاء الله

تم تعديل بواسطه mxfouad
  • Like 1

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