الـعيدروس

بالنسبة لمشكلة كود نفس الفولدر جرب بعد التعديل ان شاء الله يزبط واما شرط القيمة لاتكون صفر احاول فيه وربما لابد من تغير الية الترحيل Sub COPY_ALIDROOS() On Error Resume Next Dim W_ALI As Workbook, WB_ALI As Workbook, N_ALI$, CH_ALI$, SH_ALI As Worksheet Dim T%, R% Application.ScreenUpdating = 0 CH_ALI = ThisWorkbook.Path N_ALI = Dir(CH_ALI & "\*.xlsx") Set W_ALI = ThisWorkbook Do While N_ALI <> "" Set WB_ALI = Workbooks.Open(CH_ALI & "\" & N_ALI) For Each SH_ALI In WB_ALI.Worksheets R = SH_ALI.Cells(Rows.Count, 1).End(xlUp).Row W_ALI.Activate If SH_ALI.Name <> W_ALI Then '============================================ '(A-E-F)هنا الاعمدة المراد جلب بياناتها هيا حسب طلبك هيا ' إبتداء من السطر الثالث Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy '============================================ T = Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets(1).Range("A" & T).PasteSpecial xlPasteValues End If Next SH_ALI N_ALI = Dir WB_ALI.Close 0 Loop End Sub

جزاك الله خير اذا وجب تنصيب اوفيس 2010 لان اغلب برامجي على الأكواد مشكور جدا على هذه المعلومة

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

السلام عليكم استاذ اكواد استاذ معادلات ماذا بقيت لنا استاذ عبدالله بارك الله بعلمك وزادك علماً تقبل مروري

الحمد لله

السلام عليكم جزاك الله خير استاذ عبدالله المجرب تقبل مروري

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

اعتقد دام فيها ادخال واخراج عليك وعلى الأكسس هو اسلم حل اطرح موضوع في منتدى الاكسس وان شاء الله عباقرة الاكسس مايقصرو معاك

السلام عليكم فرضا ان خلية التذييل B120 Sub ALIDROOS_PAG() With ActiveWorkbook.Worksheets(1).PageSetup .CenterFooter = Range("B120").Value End With End Sub

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

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

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

السلام عليكم تثبيت صفوف اسفل الصفحة مااعتقد موجودة ولاكن بإمكانك التحايل بالتذيل الوسط عن طريق كود يقراء من خلية معينه هذا والله اعلم

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

السلام عليكم الاخ الفاضل ابو انس 2 جزاك الله خير على هذا الملف القيم تقبل مروري

السلام عليكم الاخ الفاضل daolabs قبل نسخ الكود استخدم ALt + Shift لتغير اللغة الى العربية بعدها انسخ الكود والصقة في مودويل في ملف الاكسل المراد كذا لن يظهر شخبطه في الكود ولاحظ هذا الكود منسوخ باللغة الانجليزية شوف كيف ظاهر Sub ALIDROOS() With æÑÞÉ1 .Range("A1").Value = "ãäÊÏì ãæÝÓíäÇ" End With End Sub وهكذا بتغيير اللغة الى العربية Sub ALIDROOS() With ورقة1 .Range("A1").Value = "منتدى أوفسينا" End With End Sub تحياتي

السلام عليكم الربط عباره عن ايه بالضبط ادخال بيانات ام فيه معادلات حسابية مربوطه في كلا الملفات ؟؟

للرفع

من قال لا اعلم فقد افتى ليست لي دراية بهذا السؤال واكوادك اعتقد انها لفيجول باسيك VB6 وليست اكواد فيجول الإكسل VBA EXCEL لاكن حاول استخدام حلقة تكرار في حدث LOAD ان شاء الله يزبط او انتظار فطاحلة الأكواد

السلام عليكم طيب هكذا بيكون اذا ملف MAIN في فولدر منفصل Sub COPY_ALIDROOS() Dim W_ALI As Workbook, WB_ALI As Workbook, N_ALI$, CH_ALI$, SH_ALI As Worksheet Dim T%, R% Application.ScreenUpdating = 0 '============================================ ' هنا تحط مسار مجلد الملفات التي تريد جلب بياناتها CH_ALI = "C:\ALI\" '============================================ N_ALI = Dir(CH_ALI & "\*.xlsx") Set W_ALI = ThisWorkbook Do While N_ALI <> "" Set WB_ALI = Workbooks.Open(CH_ALI & "\" & N_ALI) For Each SH_ALI In WB_ALI.Worksheets R = SH_ALI.Cells(Rows.Count, 1).End(xlUp).Row W_ALI.Activate '============================================ '(A-E-F)هنا الاعمدة المراد جلب بياناتها هيا حسب طلبك هيا ' إبتداء من السطر الثالث Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy '============================================ T = Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets(1).Range("A" & T).PasteSpecial xlPasteValues Next SH_ALI N_ALI = Dir WB_ALI.Close 0 Loop End Sub وهكذا بيكون اذا ملف MAIN في نفس الفولدر Sub COPY_ALIDROOS() Dim W_ALI As Workbook, WB_ALI As Workbook, N_ALI$, CH_ALI$, SH_ALI As Worksheet Dim T%, R% Application.ScreenUpdating = 0 CH_ALI = ThisWorkbook.Path N_ALI = Dir(CH_ALI & "\*.xlsx") Set W_ALI = ThisWorkbook Do While N_ALI <> "" Set WB_ALI = Workbooks.Open(CH_ALI & "\" & N_ALI) For Each SH_ALI In WB_ALI.Worksheets R = SH_ALI.Cells(Rows.Count, 1).End(xlUp).Row W_ALI.Activate If SH_ALI.UsedRange.SpecialCells(11).Row = 1 Then GoTo 1 '============================================ '(A-E-F)هنا الاعمدة المراد جلب بياناتها هيا حسب طلبك هيا ' إبتداء من السطر الثالث Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy '============================================ T = Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets(1).Range("A" & T).PasteSpecial xlPasteValues 1 Next SH_ALI N_ALI = Dir WB_ALI.Close 0 Loop End Sub جرب الكود وابلغني بالتيجة ولاتنسى تحط المسار الصحيح في حال كان الفولدر منفصل لملف MAIN والسلام عليكم

السلام عليكم بالامكان حفظ بيانات كل شهر بملف منفصل لاداعي ان تكون في ملف واحد وخاصة اذا كان الداتا كبير لذا نرجو ارفاق مثال وتوضيح ماهي الحقول المرادة وماهي الحقول التي تريدها تكون في كشف الرواتب

اخي نرجو منك ارفاق الاكواد المطلوب اختصارها او ربطها ببعض في مودويل واحد كي تتضح الصورة

انا جربت بيمسح معاي طبيعي ماهي المشكلة التي عندك او ماهو المطلوب ربما نعمل كود اخر يلبي طلبك

هل ملف MAIN ضمن الفولدر ام انه في فولدر اخر

حسب فهمي لما تريد هو حفظ الملف في درايفر D مثلا في ملف اسمه يناير غير المسار بهذا السطر ليكن Const PRUEBAS = "D:\يناير\" وعند دخول شهر جديد اعمل مجلد جديد بإسم الشهر الجديد وغير المسار بتغير الاسم فقط بدل يناير مثلا فبراير وهكذا