ترحيل حسب اسم الصفحة

[عبدالعزيز محمد]

السلام عليكم

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

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

يوجد بالمرفق توضيح اكثر .... ليس هناك داعى لرفع الملف مضغوط طالما حجمه صغير ولابد ان يكون الملف بإمتداد XLSM طالما تريد الحل بالأكواد , تم رفع الملف بدون ضغط

Aziz.xlsm

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

This Macro

Sub transfer_data()
Application.ScreenUpdating = False
Dim D  As Worksheet
Dim array_sheet, Itm
Dim Flter_rg As Range, Ro%
 array_sheet = Array("رصيد", "ديون", "حالص")
 Set D = Sheets("Data")
D.Select
 Set Flter_rg = D.Range("A2").CurrentRegion
 For Each Itm In array_sheet
 With Sheets(Itm)
      .Range("A2").CurrentRegion.Clear
        Flter_rg.AutoFilter 9, .Name
         Flter_rg.SpecialCells(12).Copy
      .Range("A2").PasteSpecial
         Ro = Cells(Rows.Count, 1).End(3).Row
          If Ro > 2 Then
           .Range("A3").Resize(Ro - 2).Value = _
           Evaluate("Row(1:" & Ro - 2 & ")")
          End If
 End With
 Next Itm
   D.Select
   D.AutoFilterMode = False
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

file included

Aziz_filter.xlsm

[خيماوي كووول]

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

تفضل اخوي العزيز

Aziz.xlsm

[أحمد يوسف]

  عبد العزيز محمد

أين انت من  كل هذه الإجابات الممتازة؟!!! لم أرى اى ضغط على الإعجاب من طرفك , وهل جزاء الإحسان الا الإحسان ؟!!!!

أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ؟!!! 💙