أريد نقل البيانات فى شيت أخر

[mohamed322]

مفرادات الراتب.xls

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

اولا- الجدول كما يفهمه برنامج الاكسل هو مجموعة من البيانات لا تحتوي على خلايا فارغة ولا مدمجة

     للغة العربية

1-الى يمينها عامود فارغ او حد الصفخة الايمن 

2- الى يسارها عامود فارغ

3-فوقها صف فارغ او حد الصفحة الاعلى

4- تحتها صف فارغ

كلمة واحدة  الجدول  كما يفهمه برنامج الاكسل مجموعة بيانات مستقلة في نطاق لا يجمعها شيء مع غيرها

لذلك كي يعمل الماكرو بشكل جيد قمت بتعديل الجدول بوضع صف فارغ في الاعلى (الصف رقم 6) و ازالة الدمج من البيانات

لذا ارجو التقيد بهذه المعلومات عند ادراج اي جدول للعمل معه بمنتهى السهولة

الكود

 Option Explicit

Sub copy_filter()
Dim M As Worksheet: Set M = Sheets("مفرد الراتب")
Dim One As Worksheet: Set One = Sheets("1")
If M.FilterMode Then
 M.ShowAllData: M.Range("B7").AutoFilter
 End If
 One.Range("B7").CurrentRegion.ClearContents
 M.Range("B7").AutoFilter Field:=3, Criteria1:="<>0", _
       Operator:=xlOr, Criteria2:="=المبلغ"
M.AutoFilter.Range.Copy _
One.Range("B7")
On Error Resume Next
M.ShowAllData: M.Range("B7").AutoFilter
End Sub

الملف مرفق

 

MOUFRADAT.xlsm

[mohamed322]

شكرااااااا جداااااااااااااااااااااا باررك الله فيك