نجوم المشاركات

مثال آخر:

اجل خذا التعديل بس وقف الخطأ و بتكون العميلة على اكمل وجه انشاء الله baset2.accdb

عذراً خطأ طباعي Book1.xlsm

الف شكر لحضرتك وضعن الكود ويعمل بشكل رائع الف شكر منتداي الغالي اوفسينا

وهنا فكرة أيضا .. شاشة انتظر من فضلك !! | سلسلة مهارات في أكسس | 06 |

اخي استعمل البحث فالمنتدى مليء بمثل هذه المواضيع تفضل انظر هنا

اخي الكريم انت طالب علم جديد ومتحمس .. فيا ليتك تطلع وتقرأ قواعد المشاركة ومنها : 1. استخدم البحث في المنتدى قبل وضع سؤالك فقد يكون مكررا. وذلك لتفادي عواقب التكرار وأهمها أن تكرار الموضوع سيصعب المهمة على من يبحث بعدك كما أنه يمكنك توفير جهد الأعضاء للإجابة على موضوع آخر لم يطرح سابقاً. 11. ممنوع طرح أكثر من سؤال في موضوع واحد ليسهل البحث عن المواضيع لاحقا. لو بحثت في المنتدى لوجدت الكثير من المواضيع تتحدث عن سؤالك هذا

تفضل جاهز إن شاء الله جمع الكشوفات1 - ماكرو.xlsm

وعليكم السلام ورحمه الله وبركاته For Each w In ThisWorkbook.Worksheets If w.Name <> "ورقة7" And w.Name <> "ورقة8" Then co1.AddItem w.Name End If Next w

وعليمن السلام بالإذن خيار آخر Sub test() Dim a, b: Dim lr& a = ActiveSheet.Range("D6:D14").Resize(, 4) ReDim b(1 To 5) b = Array(1, 3, 5, 7, 9) Workbooks.Open ("C:\Users\Ehab Elhady\Desktop\1.xlsx") With Sheets("sheet1").Cells(1, 1).Resize(, 5) lr = .Cells(Rows.Count, 1).End(xlUp).Row .Offset(lr).Value = Application.Index(a, b, 1) .Offset(lr, 5).Value = Application.Index(a, b, 4) End With Workbooks("1.xlsx").Close True End Sub

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي Option Explicit Sub Transfer() Dim wbData As Workbook, wsData As Worksheet Dim rngToCopy As Range, cl As Range Dim C As Long, LastRow As Long Dim wsMain As Worksheet: Set wsMain = ThisWorkbook.ActiveSheet Application.ScreenUpdating = False Set wbData = Workbooks.Open("C:\Users\Ehab Elhady\Desktop\1.xlsx") Set wsData = wbData.Sheets("Sheet1") Set rngToCopy = wsMain.Range("D6,D8,D10,D12,D14,G6,G8,G10,G12,G14") LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row C = 1 For Each cl In rngToCopy cl.Copy wsData.Cells(LastRow + 1, C).PasteSpecial xlPasteValues C = C + 1 Next cl wbData.Close True Application.CutCopyMode = False MsgBox " تم ترحيل البيانات بنجاح", vbInformation, "تعليمات" End Sub e_V2.rar

تفضل اخي هدا حل اخر على حسب ما فهمت من اخر ملف قمت برفعه تمت اظافة شيت جديد باسم النتائج لاستخراج تقرير كل اسبوع على حده تحت بعض في ورقة واحدة كما في الصورة ادناه . شيت النتائج مع استخراج بيانات كل اسبوع في شيت مستقل بدون تكرار للتواريخ . وحفظ الكل في مجلد في بارتشن (E) فرز بيانات V2.rar

السلام عليكم اخي صالح جرب هذا الحل بالنسبة للمجموع لم اجد الوقت للتعديل فقم بذلك اذا كان هذا المطلوب الشهادات.zip

انظر الصورة ::::: - استخدم هذا الكود في الحدث الموضح في الصورة - يجب ان يكون النموذج مفتوحا ليعمل If Me.tab.Value = Time() Then PlaySound (Application.CurrentProject.Path & "\tab.wav") End If

تفضل أخي . تجريبي-2.accdb