للخبراء فى الترحيل ( ترحيل صف بناء على لون النص فى اول خليه فى الصف )

[الطـاهر]

السلام عليكم

مرفق ملق يحتوى على أرقام فى العمود a1 

المطلوب ترحيل الصف الذى لا ييجتوى على اللون الاحمر

فى الصفحه ( استدعاء البيانات ) لكل الصفحات من 1 الى 31

مرفق ملف للتوضيح

الترحيل.rar

[ياسر خليل أبو البراء]

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

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

Sub Test()
    Dim I As Long, Sh As Worksheet

    Application.ScreenUpdating = False
        For Each Sh In ThisWorkbook.Worksheets
            If Sh.Name <> "أستدعاء البيانات" Then
                For I = 1 To Sh.Cells(Rows.Count, 1).End(xlUp).Row
                    If Sh.Cells(I, 1).Font.Color <> 255 Then
                        With Sheets("أستدعاء البيانات")
                            .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).Resize(1, 5).Value = Sh.Cells(I, 1).Resize(1, 5).Value
                        End With
                    End If
                Next I
            End If
        Next Sh
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

[الطـاهر]

بارك الله فيك وزادك الله علماً

 

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

 

[سليم حاصبيا]

بعد اذن اخي ياسر

هذا الكود ضمن الملف المرفق (بعيداً عن الحلقات التكرارية في كل ورقة عمل)

ربما يكون اسرع قليلاً

 

الترحيل salim.rar

تم تعديل يوليو 13, 2016 بواسطه سليم حاصبيا

[الطـاهر]

بارك الله فيك اخى سليم

 

لكن الكود لا يعمل

 

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

[سليم حاصبيا]

8 ساعات مضت, ٍآلـ طاهر said:

بارك الله فيك اخى سليم

 

لكن الكود لا يعمل

 

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

اليك الملف مع زر لتنفيذ الماكرو على اخر صفحة 

جرب ان تضغط على الزر (عندي يعمل بكفاءة)

 

 

الترحيل salim 1 .rar

تم تعديل يوليو 14, 2016 بواسطه سليم حاصبيا