تصفية اسماء

[خالد الشاعر]

السادة الخبراء

عندى ملف مرتبات 12 شهر وبه شيت تسوية الضرائب 

اريد عمل تصفية لكل الاسماء بدون تكرار فى اخر شيت التسوية

ولكم جزيل الشكر

جزاكم الله كل خيراً

تسوية الضرائب.rar

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

اخي خالد

تم وضع الكود المناسب بالنسبة للموظفين (دون تكرار) وكل واحد منهم عدد الاشهر

بالسنبة لباقي الجدول اظن ان ذلك ليس بالامر الصعب (مجرد نسخ و لصق من اي ورقة اتجاه الاسم المناسب)

لم افعل ذلك لضيق الوقت

 

تسوية الضرائب salim.rar

[خالد الشاعر]

استاذ سليم حاصيبا

انا عاجز عن الشكر لمجهودك و اهتمامك

ماكرو رائع جداً

لى رجاء واحد عند اضافة اوراق اخرى يبحث بها ايضاً

هل ممكن تحديد اوراق البحث فى الماكر لكى لا يبحث فى كل الملف

جزاكم الله كل خيراً

[خالد الشاعر]

للرفع

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

يمكنك استعمال هذا الماكرو لتحديد الاوراق المطلوبة (داخل الـــ Array)

ملاحظة:يجب ادراج الاسماء الحقيقية للصفحات

 مثلاً لو ان اسم الصفحة Salim  يجب كتابة    "Salim"

Sub copy_sheet()
Dim arr()
arr = Array("Sheet1", "Sheet2", "Sheet4", "Sheet5", "Sheet6", "Sheet8")
For i = LBound(arr) To UBound(arr)
  'Sheets(arr(i)).copy
  'or Sheets(arr(i)).select etc..اكتب الكود هنا
   Next
End Sub

 

[خالد الشاعر]

استاذ سليم

الف شكر استاذ سليم

هل الكود يوضع مع ماكرو MergeMyData

او مع ماكرو fil_Month_number 

و فى اى جزء من الماكرو

جزاكم الله كل خيراً

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

19 دقائق مضت, خالد الشاعر said:

استاذ سليم

الف شكر استاذ سليم

هل الكود يوضع مع ماكرو MergeMyData

او مع ماكرو fil_Month_number 

و فى اى جزء من الماكرو

جزاكم الله كل خيراً

في الاثنين معاُ

[خالد الشاعر]

استاذ سليم

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

لانى يعطى معى مشكلة فى التنفيد

ولكم جزيل الشكر

[خالد الشاعر]

للرفع

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

تقضل اخي تم معالجة الامر

تختار الاوراق من داخل الكود( 1 fil_Month_number  &   MergeMyData )

 

تسوية الضرائب salim special.rar

[خالد الشاعر]

استاذ سليم

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

على هذا الكود ارائع

ولو يسع صدرك لسؤال اخر

1- لماذا يمسح عنوان الخلية C12 فى صفحة التسوية مع كل استدعاء للاسماء " أسماء السادة الموظفين" او اى جملة فى هذه الخلية 

2- لو عملت حماية للشيت protect الماكرو لا يعمل

جزاكم الله كل خير و جعلة فى ميزان حسناتك

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

هذا لان هناك خلايا مدمجة (مما يعيق عمل الكود)

لحل هذه المشاكل

استبدل الكود الاول بهذا (يمكنك تفيير الباسورد من داخل الماكرو) الحالي هو 123

Sub MergeMyData1()
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If ActiveSheet.Name <> "تسوية" Then Exit Sub
On Error Resume Next
  With Sheets("تسوية")
.Unprotect Password:="123"
.Range("c13", Range("c" & Rows.Count).End(xlUp)).ClearContents
.Range("az1", Range("az" & Rows.Count).End(xlUp)).ClearContents
.Range("h2:at2").ClearContents
End With
'=======================================
Dim arr()
arr = Array("1", "2", "4", "5", "6", "8")
For i = LBound(arr) To UBound(arr)
 Sheets("تسوية").Cells(2, kk + 8) = arr(i)
Set ws = Sheets(arr(i))
           ws.Range("b13", ws.Range("b" & ws.Rows.Count).End(xlUp)).Copy Sheets("تسوية").Range("az" & Rows.Count).End(xlUp).Offset(1)
 
 
kk = kk + 1
Next

Sheets("تسوية").Range("c13", Range("c" & Rows.Count).End(xlUp)).ClearContents
With Sheets("تسوية").Range("az1", Range("az" & Rows.Count).End(xlUp))
    .sort Key1:=Range("az1"), _
        Order1:=xlAscending, _
        Header:=xlNo, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
End With
   Sheets("تسوية").Range("az1", Range("az" & Rows.Count).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
  Sheets("تسوية").Range("az1", Range("az" & Rows.Count).End(xlUp)).SortSpecial
  Sheets("تسوية").Range("az1", Range("az" & Rows.Count).End(xlUp)).Cut Sheets("تسوية").Range("c13")
  

  fil_Month_number
 Sheets("تسوية").Range("c12") = "أسماء السادة الموظفين"
 Sheets("تسوية").Protect Password:="123"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub

 

[خالد الشاعر]

استاذ سليم

شكرا على سرعة الرد و الاهتمام

جزاكم الله كل خيراً

تم تعديل نوفمبر 1, 2016 بواسطه خالد الشاعر

[ميدو63]

الاسادة الزملاء

 

حاولت من باب الفضول والتعلم تنزيل الملف  فاحترت اين الصق الكود الاخير - فالصقتة فى الــــ New_Model - فعل هذا صحيح

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

فهل يمكن الشرح او التعديل حتى استطيع ان استغلة فى شيتات أخرى

[خالد الشاعر]

استاذ ميدو

مرفق الملف الاخير بالتعديل النهائي

 

تسوية الضرائب salim special.rar

[ميدو63]

اشكرك جزيلا وسوف اقوم بتجربتة

[سيد الأكرت]

جزاك الله خيرا

[خالد الشاعر]

كل الشكر للاستاذ سليم