أبوعبدالرحمن- قام بنشر يناير 2, 2012 مشاركة قام بنشر يناير 2, 2012 السلام عليكم ورحمة الله وبركاته لدي مشروع واريد أن استفسر عنه بارك الله فيكم وهو خاص بجلب بيانات من ملفات خارجية إلى ملف رئيسي وهذا الملفات جميعا تكون داخل مجلد واحد فهل من الممكن غفر الله لكم ولوالديكم شرح طريقة عمل ذلك ... سواءً عن طريق كود أو معادلة واذا تم زيادة عدد الملفات فيما بعد هل سيتم إعادة عمل الكود أو المعادلة لإدراج مسميات الملفات الجديدة... أم ان الملفات الجديدة لايهم اسمائها ويتم جلب بياناتها وشكرا للجميع Mine.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر يناير 2, 2012 مشاركة قام بنشر يناير 2, 2012 (معدل) هل ملف MAIN ضمن الفولدر ام انه في فولدر اخر تم تعديل يناير 2, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 2, 2012 الكاتب مشاركة قام بنشر يناير 2, 2012 اخي العزيز ابو نصار السلام عليكم ورحمة الله وبركاته في الغالب اخي العزيز يكون الملف في نفس الفولدر ولكن ان امكن من طرح الخيارين أي ان ملف Main في نفس الفولدر أو خارج الفولدر فاكون لك من الشاكرين جزاك الله كل خير وبارك فيك رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر يناير 2, 2012 مشاركة قام بنشر يناير 2, 2012 (معدل) السلام عليكم طيب هكذا بيكون اذا ملف 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 والسلام عليكم تم تعديل يناير 3, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 3, 2012 الكاتب مشاركة قام بنشر يناير 3, 2012 (معدل) وعليكم سلام الله ورحمته وبركاته اخي الفاضل ابو نصار جزاك الله خير على مساعدتك وليس بغريب عليك هذا الابداع فتبارك الله اخي الفاضل واجهتني مشكلة وهناك ايضا تعديل المشكلة هي : الكود الثاني اذا كان ملف Main داخل الفولدر تظهر رسالة خطأ ويشير الخطأ إلى السطر 14 من الكود Then GoTo 1 التعديل هو : عند تجربة الكود الأول والذي يعمل بشكل سليم ورائع وجدت أنه يقوم بجلب بيانات الأجهزة جميعها من الملفات الاخرى والمطلوب هو أن يجلب فقط بيانات الأجهزة التي تم صرفها أو ( بيعها ) ولو تلاحظ عند تنفيذ الكود يكون هناك بيانات تحتوي على قيمة صفر ( 0 ) في ملف Main للعمود الإجمالي والمطلوب أن لايتم جلب هذه الأجهزة لذلك لو تم الاشتراط في عدم نقل البيانات التي تحتوي على قيمة صفر في عمود الصرف في جميع الملفات اكرر لك شكري وتجاوبك وجزاك الله خير تم تعديل يناير 3, 2012 بواسطه أبوعبدالرحمن- رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 3, 2012 الكاتب مشاركة قام بنشر يناير 3, 2012 طلب اخير اخير بارك الله فيك هل يوجد امكانية في تحديد وقت معين بالساعة لعدم تنفيذ الكود ... بناءا على توقيت الجهاز .. وليكن الساعه 8 صباحاً وذلك من اجل عملية جرد مبيعات ذلك اليوم وايضا إمكانية تحديد وقت آخر لمسح بيانات ملف Main استعدادا لجلب بيانات جديده وليكن الساعه 12 مساءاً رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر يناير 3, 2012 مشاركة قام بنشر يناير 3, 2012 (معدل) بالنسبة لمشكلة كود نفس الفولدر جرب بعد التعديل ان شاء الله يزبط واما شرط القيمة لاتكون صفر احاول فيه وربما لابد من تغير الية الترحيل 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 تم تعديل يناير 3, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 4, 2012 الكاتب مشاركة قام بنشر يناير 4, 2012 السلام عليكم اخي ابو نصار بارك الله فيك نعم الكودين يعملان بشكل صحيح فشكرا لك من الأعماق وجزاك الله خيرا بقي شرط عدم الترحيل عندما تكون القيمة بالنسبة لعمود الصرف C تساوي = صفر وايضا هذين الطلبين : طلب اخير اخير بارك الله فيك هل يوجد امكانية في تحديد وقت معين بالساعة لعدم تنفيذ الكود ... بناءا على توقيت الجهاز .. وليكن الساعه 8 صباحاً وذلك من اجل عملية جرد مبيعات ذلك اليوم وايضا إمكانية تحديد وقت آخر لمسح بيانات ملف Main استعدادا لجلب بيانات جديده وليكن الساعه 12 مساءاً رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 6, 2012 الكاتب مشاركة قام بنشر يناير 6, 2012 السلام عليكم ورحمة الله وبركاته اخي العزيز ابو نصار هل هناك إمكانية تنفيذ ما ذكر بارك الله فيك في مشاركتي التي بالاعلى رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر يناير 6, 2012 مشاركة قام بنشر يناير 6, 2012 بالنسبة للتوقيت يوجد كود يقوم بعمل ماتريده ولاكن طلبك غير واضح =================================== هل يوجد امكانية في تحديد وقت معين بالساعة لعدم تنفيذ الكود ... بناءا على توقيت الجهاز .. وليكن الساعه 8 صباحاً "إقتباس" وذلك من اجل عملية جرد مبيعات ذلك اليوم =================================== هل تعني يوم محدد وساعه محدده ام ساعه في كل يوم والشرط حاولة فيه لم اتوصل الى حل ولاكن سوف اكرر المحاولة وان شاء الله نتوصل لحل تحياتي رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 6, 2012 الكاتب مشاركة قام بنشر يناير 6, 2012 السلام عليكم ورحمة الله وبركاته اخي الفاضل ابو نصار لك كل التقدير والاحترام على هذا العطاء اخي العزيز بالنسبة للتوقيت فالمطلوب هو كالتالي: - من المعلوم لشخصكم الكريم أن ملف Main يجلب البيانات من ملفات أخرى فالذي اريده هو وقف عمل الكود عند الساعة 11 مساءً كمثال من كل يوم .. وايضا لازلت ارغب في الحصول على جلب البيانات حسب القيمة عندما لا تساوي = صفر في الملفات الأخرى جزاك الله كل خير...... رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر يناير 7, 2012 مشاركة قام بنشر يناير 7, 2012 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 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.Cell... استسمحك ان تضع اكوادك الجميله في ملف حتى استطيع فهمها وشكرا لكم رابط هذا التعليق شارك More sharing options...
أبوعبدالرحمن- قام بنشر يناير 7, 2012 الكاتب مشاركة قام بنشر يناير 7, 2012 السلام عليكم ورحمة الله وبركاته الاخ العزيز ابو نصار أتمنى أن تكون وفقت في عملية ايجاد آلية الترحيل عندما لا تكون القيمة صفر كما أرجوا أن يكون ردي السابق بخصوص التوقيت قد أوضح لك الإشكال وفقت لك خير وبارك فيك رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.