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

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


angelloay

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

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

احبائي الرجاء مساعدتي في طلبي وهو كالتالي

لدي صفحة فيها معطيات وعند تدقيقها اقوم بتلون الصف او خلية محددة بلون ما

المطلوب

ترحيل الصف كاملا من ورقة1 الى ورقة2 اذا قمت بتلون الصف او خلية محددة منه مع مسح الصف من الورقة 1

حاولت كثيرا ولكن لم استطع الترحيل حسب اللون والصف كاملا

نجحت معي الطريقة حسب اللون

ونجحت ايضا حسب الصف ولكن لم تنجح معي مجتمعتين اللون والصف معا

وفي كلتا الحالتين لم ينحج المسح معي

شكرا لتعاونكم واسف على اي ازعاج لكم

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

السلام عليكم

أخي كان من الأحسن رفع ملف للعمل عليه

هذا تصور لما طلبته و لا ادي هل تقصد بهذه الطريقة ام هناك خطأ في فهمي للسؤال

ترحيل صف كامل الى ورقة جديدة حسب اللون.rar

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

اخي ابو حنين

جربت الملف لكن الكود لا يرحل

==

الافضل وضع الكود في زر أمر

وننتظر مرفق صاحب الطلب لمعرفة ما يريد

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

شكرا لك اخي على الرد

اولا هذا طلبي تمام ولكن

لايوجد زر ترحيل ولا استطيع الترحيل من صفحة الى اخرى

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

وشكرا لك

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

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

تماما اخي الكود لم يعمل وهل ارفاق الملف امر ضروري؟

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

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

السلام عليكم

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

===

قمت بعمل كود في زر امر للترحيل مع حذف المرحل


Sub Abu_Ahmed()

Dim cl As Range

For Each cl In Range("A2:J" & [A10000].End(xlUp).Row)

If cl.Interior.ColorIndex <> xlNone Then

Cells(cl.Row, 1).Resize(1, 10).Copy Sheets("COPYY").Range("A" & Sheets("COPYY").[A10000].End(xlUp).Row + 1)

cl.EntireRow.Delete

End If

Next

End Sub

شاهد المرفق

111.rar

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

الله يعطيك العافية الامر تمام وهذا الطلب تمام

ولكن هناك امر بسيط

عندما اقوم بتحديد اي خلية يقوم بنقل الصف كاملا وانا اريد عند تحديد خلية معينة كما زكرت سابقا (خلية معينة مثل H ) يقوم بترحيل البيانات

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

اخي جربت تعديل بسيط


Sub Abu_Ahmed()

Dim cl As Range

For Each cl In Range("A2:A2" & [A10000].End(xlUp).Row)

If cl.Interior.ColorIndex <> xlNone Then

Cells(cl.Row, 1).Resize(1, 16).Copy Sheets("COPYY").Range("A" & Sheets("COPYY").[A10000].End(xlUp).Row + 1)

cl.EntireRow.Delete

End If

Next

End Sub

في هذا التعديل قمت بتفعيل الخلية A2 فقط ولو انه قمت بتلون اي خليه اخرى بالصف لن يرحل الصف ابدا

اما اذا قمت بتلون الصف كاملا فانه تلقائيا سوف يقوم بتلون الخلية المحددة A2 وبالتالي سوف يقوم بترحيله وحذفه

اريد ان يكون هذا الامر مفعلا على كامل العمود A او B او اي عمود اخر لافرق لدي

وشكرا

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

تفضل جرب هذا التعديل


Sub Trheel1()

With Application

.ScreenUpdating = False

.EnableEvents = False

For R = [A10000].End(xlUp).Row To 3 Step -1

For C = 1 To 16

If Cells(R, C).Interior.ColorIndex <> xlNone Then

Range(Cells(R, 1), Cells(R, 16)).Copy _

Sheets("المناقلات المنتهية").Range("A" & Sheets("المناقلات المنتهية").[A10000].End(xlUp).Row + 1)

Cells(R, 1).EntireRow.Delete

End If

Next

Next

.ScreenUpdating = False

.EnableEvents = False

End With

End Sub

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

السلام عليكم

اعتذر عن تأخري في الرد لظروف العمل

لكن الكود الذي ارسلته للاخ في مشاركتي رقم 2 يعمل بطريقة عادية عندي بحيث :

ـ اولا قم بتلوين اي خلية

ـ اخرج من الخلية ثم عد اليها تجد البيانات قد ثم ترحيلها للورقة الثانية

ـ تستطيع عمل زر و نسخ الكود الى هذا الزر مع حذف السطر الاول من الكود

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

بارك الله بكم اساتذه بكل معنى الكلمة

الموضوع بعد التعديلات من الاخوة انحل بشكل كامل واصبح الملف ممتاز

ولدي طلب اخر واسف لازعاجكم به

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

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

ولدي طلب اخر واسف لازعاجكم به

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

ضعه في طلب جديد

===

بالفعل اخي ابو حنين فكودك يعمل تمام

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information