hassona229

اخى الكريم يمكنك الاستفادة من هذا الموضوع

وعليكم السلام ورحمة الله وبركاته الملف الخاص بك ليس به مشاكل

آمين يارب العالمين وإياكم الحمد لله الذي بنعمته تتم الصالحات

يمكنك الاستفادة من هذا الموضوع هنا فيه الموضوع الاصلي للبرنامج

اخى الكريم محمد عبدالصمد هل كتبت الارقام من ٥ الى نهايه ارقامك ال ٥٠٠٠ اسم كما طلب منك الاستاذ الكبير بن علية حاجى في المشاركه السابقه

اجعل تنسيق الخلايا general وستجد المعادله سليمه

الكود الخاص بك كان فيه حلقه تكراريه لطباعه جميع النطاق حتى لو كان لايوجد بيانات في النطاق فعدلت لك الكود بحيث ان لم يكن يوجد بيانات يتوقف الكود If Isnull([d12]) or [d12] = 0 then Exit

وعليكم السلام ورحمة الله وبركاته الحمد لله بنعمه تفضل جرب هذا التعديل لعله يفي بالمطلوب test.xlsm

تفضل اخى الكريم الملف بعد وضع الكود به كشوفات الطلبة للعام 2021-2022.xlsm

قبل كل كلمه اسمها Function ضع كلمه Ptrsafe لتصبح الكلمه PtrSafe Function

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

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

وجزاكم مثله اخى الكريم آمين يارب العالمين وإياكم

وعليكم السلام ورحمة الله وبركاته ارفق ملفك الذي به المشكله وبين أين تظهر المشكله

وكود اخر اخى الكريم بدون مصفوفات Sub Total() Dim ws As Worksheet, SH As Worksheet Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False If Not Evaluate("isref('" & "Total" & "'!A1)") Then Sheets.Add.Name = "Total" Set SH = ThisWorkbook.Worksheets("Total") SH.Range("A1").Resize(1, 19).Value = Array("V", "HH", "J", "K", "L", "DD", "HH", "K", "L", "P", _ "GG", "S", "DF", "GH", "HJ", "KJ", "FGH", "G", "Remarks") For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Total" And ws.Name <> "SUMMARY" And ws.Name <> "TIME" And ws.Name <> "HOLD" Then 'كود للنسخ العادي بدون مصفوفات ويجلب لك نفس تنسيق البيانات الاصليه ws.Range("A6:S" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Copy _ SH.Range("A" & SH.Cells(Rows.Count, 2).End(xlUp).Row + 1) End If Next ws SH.Range("A1:S" & SH.Cells(Rows.Count, 2).End(xlUp).Row).EntireColumn.AutoFit Sheets("Total").Move ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Total.xlsb", FileFormat:=xlExcel12 Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False End Sub