اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

مداد_1423

02 الأعضاء
  • Content Count

    59
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

12 Good

1 متابع

عن العضو مداد_1423

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    متسبب
  • بلد الإقامة
    السعودية
  • الإهتمامات
    إكسل ـ وورد

اخر الزوار

450 زياره للملف الشخصي
  1. تم الحل بعد محاولات وتجارب لكن حصل المقصود لكم الشكر يا سادة Sub copy_data() Dim S As Worksheet: Set S = Sheets("ALL") Dim Q As Worksheet: Set Q = Sheets("Shift Schedule") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_Q: Final_Q = Q.Cells(Rows.Count, 1).End(3).Row Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim RQ As Range: Set RQ = Q.Range("A8:AG" & Final_Q) Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, XQ, xO%, XA%, xx% XQ = RQ.Rows.Count: xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > XQ S.Cells(xx, 1) = RQ.Cells(i, 1) S.Cells(xx, 3).Resize(, RQ.Columns.Count - 2).Value = _ RQ.Cells(i, 3).Resize(, RQ.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 9 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 10 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop End Sub
  2. تحية طيبة وبعد:- أتمنى يكون الجميع بصحة وسلامة لدي ملف في كود من إبداع أستاذنا سليم حاصبيا المطلوب إضافة شيت جديد بحيث يكون ترتيب التجميع في شيت ALL أولا: Shift Schedule ثانيا: Overtime ثالثا: Attendance ويكون التجميع بيانات من غير تنسيق إذا أمكن مع الشكر لكل من مر هنا وأخص بالشكر والدعاء من ساعدني تحياتي Option Explicit Sub copy_data() Dim S As Worksheet: Set S = Sheets("ALL") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, xO%, XA%, xx% xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop i = 1: xx = 9 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop End Sub HR_TEST1.xlsm
  3. الأستاذ احمد بدره نفع الله بك وبارك في علمك وصحتك ووقتك الملف تمام وهذا المطلوب لك وللأستاذ الفاضل علي جزيل الشكر وخالص الدعاء تحياتي
  4. أستاذنا : علي بارك الله فيك ومتعك بصحتك وأسبغ عليك نعمه أولاً أشكرك لأني عرفت كيف أعين الشيت الذي أريد من عدة شيتات في الملف لكن الكود لا يقوم بالمطلوب جربت فصلت الكود ودمجتهم ما نفع Sub MACROS() Call Macro2 Call Macro1 End Sub لكن لمن أشغل كل كود وحدة تكون النتيجة صحيحة للعلم : الشرط في خلية AP3 أكبر من 79 يكون فيه اعتماد لاحظ المرفق HR_TEST2.xlsm
  5. تحية طيبة آمل أن يكون طلبي خفيف على حضراتكم لدي كود يعمل بكفاءة وهذا هو Sub Macro1() Dim i As Integer, m As Integer Application.ScreenUpdating = False For i = 2 To 4 With ThisWorkbook.Worksheets(i) m = .Cells(Rows.Count, 1).End(xlUp).Row If i <> 3 Then .Range("A1:AH" & m).PrintOut Copies:=1, Collate:=True ElseIf i = 3 Then If .Range("AH" & .Cells(Rows.Count, "AH").End(xlUp).Row).Value > 0 Then .ListObjects("HR_2").Range.AutoFilter Field:=34, Criteria1:=">0" .Range("A1:AH" & m + 1).PrintOut Copies:=1, Collate:=True .ListObjects("HR_2").Range.AutoFilter End If End If End With Next i Application.ScreenUpdating = True End Sub أريد أن أضيف هذا السطر بحيث يكون فعال في شيت (Overtime) فقط ActiveSheet.PageSetup.RightFooter = Range("AP3").Value لأني أريد أن يظهر الشرط الموجود في خلية AP3 في الركن الأيمن في تذييل الصفحة الكود اختبرته على ملف من شيت واحد وفعال ولكن ما عرفت أضيفه على شيت الأوفرتايم ملاحظة: الكود يقوم بطباعة جميع الشيتات ، لذا وجب التنبيه تحياتي HR_TEST2.xlsm
  6. وعليكم السلام ورحمة الله وبركاته أولاً: جزاك الله خيرا ، وشكر الله لك ومتعك بصحتك ثانياً : أعتذر عن التأخير لبعدي عن الكمبيوتر في الإجازة الأسبوعية ثالثاً: ما أدري أنا ما عرفت استخدم الكود أو أن الكود ناقصه شيء الصورة المتحركة يظهر فيها أن كلمة أبروف متواجدة سواء كان فيه قيمة أكثر من 60 أو لم يوجد شيء
  7. يستاهل كل خير أبارك لك اللقب الذي تستحقه عن جدارة تحياتي
  8. السلام عليكم جميعاً تحية طيبة عندي ملف للعمل الإضافي أضفت عليه تذييل صفحة تظهر عند الطباعة السؤال : بغيت أضيف اعتماد (Approve) إذا زادت قيمة مجموع الصف 60 أو أكثر (عامود AH) داخل الجدول طبعا وليست المجموع النهائي سواء بكود أو خلية مساعدة أو أي طريقة شكرا لك من مر من هنا وأخص بالشكر والدعاء من ساعدني على حل المشكلة تحياتي Ot.xlsx
  9. في خلية B1 جرب تغير نص الخلية من Government Exp إلى Government_Exp بحيث تستبدل المسافة بالشرطة السفلية وبتزبط معك المشكلة عندك في تسمية صف العناوين (المسافات) تحياتي
  10. تحية طيبة مباركة للجميع أدام الله عليكم لباس الصحة جميعا وجدت كود للأستاذ سليم حاصبيا لتجميع البيانات من الشيتات إلى شيت رئيسي وهو كود رائع وسريع لكن ما قدرت أعدل عليه حتى يعمل مع الملف عندي الكود: Sub Give_ALL_Data() Dim Arr_sh(), i%, m%: m = 2 Dim Arr_counte() For i = 1 To Sheets.Count - 3 ReDim Preserve Arr_sh(1 To i) ReDim Preserve Arr_counte(1 To i) Arr_sh(i) = Sheets(i).Name Arr_counte(i) = Application.Max(Sheets(i).Range("a:a")) Next Sheets("ALL").Range("A3:AH1000").ClearContents For i = LBound(Arr_sh) To UBound(Arr_sh) Sheets("ALL").Range("A" & m).Resize(Arr_counte(i), 8).Value = _ Sheets(Arr_sh(i)).Range("A3").Resize(Arr_counte(i), 8).Value m = m + Arr_counte(i) + 1 Next Erase Arr_sh: Erase Arr_counte End Sub المطلوب تختصره الصورتين أولاً: ثانياً: لكل من مر من هنا تحية ولكل من ساعدني دعوة خالصة وشكرا من الأعماق تحياتي TEST_ _HR.xlsm
  11. بحمد الله تمكنت من التعديل على الكود الأول (تجميع شيت من عدة ملفات في فولدر) والكود يعمل بكفاءة عالية ولله الحمد Sub CollectWorkbooks() Dim Path As String Dim Filename As String Dim SH As Worksheet Dim X As Long X = 2 Path = ThisWorkbook.Path & "\Files\" Filename = Dir(Path & "*.xlsm") Application.ScreenUpdating = False Application.DisplayAlerts = False For Each SH In ThisWorkbook.Sheets If SH.Name <> "Nep_HR" And SH.Name <> "ALL" Then SH.Delete Next SH Do While Filename <> "" Workbooks.Open Filename:=Path & Filename, ReadOnly:=True For Each SH In ActiveWorkbook.Sheets If SH.Name <> "Overtime" Then GoTo 1 SH.Copy After:=ThisWorkbook.Sheets(X) X = X + 1 1 Next SH Workbooks(Filename).Close Filename = Dir() Loop Sheets("Nep_HR").Activate Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub بقي التعديل على الكود الثاني وهو تجميع بيانات ملف في شيت واحد تجمع البيانات في شيت ALL بدءًا من الخلية A3 بحيث بيانات العامود A من الشيتات الأخرى تكون في العامود A والعامود C من الشيتات الأخرى تكون في العامود B الكود الذي أريد التعديل عليه بناء على من وضحته في هذه المشاركة بالصور أعلاه Sub Give_ALL_Data() Dim Arr_sh(), i%, m%: m = 2 Dim Arr_counte() For i = 1 To Sheets.Count - 3 ReDim Preserve Arr_sh(1 To i) ReDim Preserve Arr_counte(1 To i) Arr_sh(i) = Sheets(i).Name Arr_counte(i) = Application.Max(Sheets(i).Range("a:a")) Next Sheets("ALL").Range("A3:AG1000").ClearContents For i = LBound(Arr_sh) To UBound(Arr_sh) Sheets("ALL").Range("A" & m).Resize(Arr_counte(i), 8).Value = _ Sheets(Arr_sh(i)).Range("A3").Resize(Arr_counte(i), 8).Value m = m + Arr_counte(i) + 1 Next Erase Arr_sh: Erase Arr_counte End Sub ملاحظة : فولدر فايل في المشاركة الرئيسية لمن أراد أن يستفيد من تجميع شيت من عدة ملفات TEST__HR.xlsm
  12. ويرزقكم من حيث لا تعلمون مع أن طلبي مختلف عن الكود تماما إلا أن هذا الكود ينفعني كثيرا واستحيت أطلبه من حضراتكم لأني توقعت بناء الكود صعباً ألف ألف شكر وتقدير لك أستاذي سليم على الكود الرائع وما زلت أنتظر تعديل الكود في المرفق في المشاركة الأساسية على حسب ما هو موضح بالصور تحياتي لشخصك الكريم
  13. من لوحة المفاتيح اضغط على زر Home ثم اضغط Backspace وستصعد الكتابة إلى أعلى إن شاء الله
  14. تحية طيبة للجميع بداية أشكر كل من في هذا المنتدى الذي استفدت منه كثيرا أشكر الأستاذ: ياسر خليل أبو البراء على كود دمج الملفات في ملف واحد والذي أخذته من هذا الموضوع والكود يعمل بكفاءة عالية ، المطلوب : 1) قبل الدمج تحذف جميع الشيتات ما عدى أول وثاني شيت 2) تعديل الكود بحيث يجمع فقط شيت Overtime فقط وليس كل الشيتات ==== ثانياً: أشكر الأستاذسليم حاصبيا على كود تجميع البيانات من شيتات إلى شيت واحد في هذه المشاركة المطلوب: 1) حذف بيانات شيت ALL من A3:AF1000 كما في الصورة 2) تجميع بيانات الشيت من A8 إلى آخر خلية فيها بيانات من نفس العامود إلى العامود AG باستثناء العامود B لا أريد أن يكون في التجميع صورة توضيحية أتمنى ما يكون طلبي ثقيل على حضراتكم مع الشكر لكل من مر هنا ، وأخص بالشكر والدعاء من ساعدني والله يقدرنا على رد فضلكم علينا وهنيئا لصاحب العلم زكاة علمه تحياتي TO_Officena.rar
  15. جزاك الله خير الجزاء أستاذ حسين الكود يعمل بكفاءة كما أحب ، شكر الله لك وبارك فيك تحياتي
×
×
  • اضف...