استخراج الصفوف التى بها خليه معينة ( فارغه ) الى شيت جديد

[mostafa_27]

السلام عليكم اخوانى

ارجو من حضراتكم المساعده

بخصوص

 

استخراج الصفوف التى بها خليه معينة ( فارغه )

الى شيت جديد

 

 

و شاكر لكم

 

مرفق مثال

 

 

 

AAA.xls

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

جرب هذا الكود

Option Explicit

Sub transfer()
    Dim Target_Sh As Worksheet
      Set Target_Sh = Sheets("الغياب")
    Dim Single_sh As Worksheet
    Dim My_row%
    Dim i%, s#
    Dim ara As Range
    Dim Blank_Range As Range
    
My_row = Target_Sh.Cells(Rows.Count, 1).End(3).Row + 1
 For Each Single_sh In Worksheets
     If Single_sh.Name = Target_Sh.Name Then GoTo 1
      Set Blank_Range = Single_sh.Range("a1") _
     .CurrentRegion.Columns(5)
   On Error Resume Next
   Set Blank_Range = Blank_Range.SpecialCells(xlCellTypeBlanks)
   s = Err.Number
   If s <> 0 Then s = 0: GoTo 1
     s = 0
    For Each ara In Blank_Range.Areas
        Target_Sh.Cells(My_row, 1).Resize(ara.Rows.Count, 5).Value = _
        ara.Offset(, -4).Resize(ara.Rows.Count, 5).Value
        My_row = My_row + ara.Rows.Count
    Next
   
1:
Next

End Sub

الملف مرفق

 

AAA_Salim.xlsm

[mostafa_27]

الحبيب الغالى استاذ  @سليم حاصبيا

 

شكرا جزيلا للمساعدة

 

دائما تقدم لنا المساعدة  جزاك الله خــــيرا