أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
مهند محسن ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil تجميع العديد من الملفات في ملف واحد اكسيل اسئله واجابات


اعلان هنا
صقور الاكسيل
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا


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





تجميع العديد من الملفات في ملف واحد

السلام عليكم و رحمة الله لدي العديد من الملفات حوالي 265 ملف و كل ملف يحتوي معلومات معينة و عدد الاوراق اثنان و نفس الا ..



26-03-2020 06:06 مساء
نجيب12
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 25-12-2019
رقم العضوية : 17178
المشاركات : 6
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 1-7-1979
قوة السمعة : 12
الاعجاب : 1
 offline 
السلام عليكم و رحمة الله 
لدي العديد من الملفات حوالي 265 ملف و كل ملف يحتوي معلومات معينة و عدد الاوراق اثنان و نفس الاسم للاوراق  و كل ملف باسم معين  و نفس الجدول في الاوراق كلها 
اقوم بالتجميع بملف ماكرو  حيث يقوم بالتجميع من كل الملفات  و كل ملف على حدى   . يقوم بفتح الملف و اخذ المعلومات الى  ملف التجميع  و يغلقه و من ثم الى باقي الملفات 
عند كتابتي للماكرو اكتبه 256 مرة  و احدد اسم الملف المراد اخذ المعلومات منه و نسخ و لصقها الى ملف التجميع .
و الحيلة التي استعملها هي  استعمال ليست في الاكسال و تعيين مسار الملفات حيث يضع لي كل الملفات الموجودة بالمجلد  و من ثم انسخ نفس الماكرو في صفحة الاكسال و بمعادلة فوركاب اقوم بتغيير اسم الملف في المكرو و  يقوم بوضع 256 مكرو منفرد و اجمعها بالنسخ و اللصق في الموديل و اقوم بتطبيق المكرو 
. اريد وضع مكرو واحد اوضح له عدد او مكان الملفات مهما كان اسمها و مهما كان تعدادها و هو يقوم بالتجميع في الصفحة .
و هذا مثال  للعمل على ملف واحد 
Sub nad()
Workbooks.Open Filename:= _
"C:nadjibRD1_120101.xlsm"
 ActiveSheet.Unprotect Password:="12"
Sheets("RD").Range("a2:K200" & Cells(Rows.Count, "c").End(xlUp).Row).Copy
    Workbooks("ALL.xlsm").Sheets("n").Activate
     Workbooks("ALL.xlsm").Sheets("n").Range("c" & Rows.Count).End(xlUp).Rows.Offset(1, 0).Select
    Selection.PasteSpecial xlPasteValues
Windows("RD1_120101.xlsm").Activate
  Application.CutCopyMode = False
    ActiveWindow.Close
 
   End Sub




26-03-2020 06:33 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 8641
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 21
قوة السمعة : 25468
الاعجاب : 172
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
وعليكم السلام أخي الكريم
ارفق نموذجين من الملفات التي تقوم بتجميعها وضع معهما ملف ثالث فيه شكل النتائج المتوقعة .. وهل سيتم التعامل مع ورقة واحدة في كل ملف من الملفات التي تتعامل معها أم التعامل مع الورقتين ؟ وإذا كان التعامل مع الورقتين هل سيكون التجميع لكل البيانات من كلتا الورقتين أم أن لكل ورقة منهما سيكون هناك ورقة تجميع منفصلة .. الأفضل وضع شكل النتائج المتوقعة

أثارت هذه المشاركة إعجاب: نجيب12،



26-03-2020 07:10 مساء
مشاهدة مشاركة منفردة [2]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1475
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 4
قوة السمعة : 9351
الاعجاب : 32
 Online 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
تم تعديل الموضوع لوضع النص الكودى بين مربع التحرير الخاص به
يرجى اتباع تلك الأمور عند وضع أكواد وذلك بتطبيقه كما بالصورة التالية

GOkhM_2020-03-26_190756
 
 


أثارت هذه المشاركة إعجاب: YasserKhalil، نجيب12،



26-03-2020 09:23 مساء
مشاهدة مشاركة منفردة [3]
نجيب12
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 25-12-2019
رقم العضوية : 17178
المشاركات : 6
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 1-7-1979
قوة السمعة : 12
الاعجاب : 1
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
ملف all هو ملف التجميع حيث اعتمد عليه في معرفة عدد و اسماء الملفات الموجودة  في المجلد nadjib  و من خلاله اصنع المكرو تلقائي و اجده مكتوب حسب الملفات  في الصفحة name 
و التجميع في الصفحة n 
اريد عمل مكرو واحد يتعرف على كل الملفات في مجلد معين احدده و ياخذ المعلومات من صفحة محددة و يضعها في  ملف التجميع . و ان امكن ان لا يفتح الملفات احسن 
شكرا لاخوتي الكرام
 
 
  ALL.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(739.078) KB
  RD1_120101.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(58.003) KB





27-03-2020 12:26 صباحا
مشاهدة مشاركة منفردة [4]
ابراهيم الحداد
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 165
الجنس : ذكر
الدعوات : 1
قوة السمعة : 1389
الاعجاب : 17
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
السلام عليكم ورحمة الله
حاول ان تجرب ملف الاول بعد اضافة يوزرفورم لجلب البيانات من اى شيت 
فى اى مكان بالجهاز سواء فى نفس الدرايف او درايف آخر
او على ملف فى مجلد فى نفس الدرايف او درايف آخر
اوملف فى مجلد داخل مجلد
 
 
  ALL.xlsm   تحميل xlsm مرات التحميل :(5)
الحجم :(117.043) KB


أثارت هذه المشاركة إعجاب: ali mohamed ali، YasserKhalil، نجيب12،



27-03-2020 07:14 مساء
مشاهدة مشاركة منفردة [5]
نجيب12
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 25-12-2019
رقم العضوية : 17178
المشاركات : 6
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 1-7-1979
قوة السمعة : 12
الاعجاب : 1
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
شكرا استاذ .فكرة جد رائعة الا ان هناك مشكل في الماكرو و الصورة توضح ذلك 
ان صلحت الفكرة هل يمكن تطبيقها دون تعيين الملف . اي تطبيقها على المجلد و ما يحتويه 
 
 
  Sans titre.png   تحميل png Sans titre.png مرات التحميل :(0)
الحجم :(128.382) KB
  Sans titre1.png   تحميل png Sans titre1.png مرات التحميل :(0)
الحجم :(68.687) KB
 





27-03-2020 08:30 مساء
مشاهدة مشاركة منفردة [6]
نجيب12
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 25-12-2019
رقم العضوية : 17178
المشاركات : 6
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 1-7-1979
قوة السمعة : 12
الاعجاب : 1
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
عند ترحيل المعلومات  يقوم بالترقيم  و ياخذ 19 سطر من الجدول فقط  .
العملية ناجحة بعد التغيير في المكرو الا انه بقي الترقيم لم استطع نزعه . ان امكن ان ياخد كل المعلومات من لصفحة المطلوبة حت الى السطر 300 مئة و يضع المعلومات كما هي .
اعتذر استاذ شكرا على المجهود و جزاك الله كل خير 
للعلم الرقم الاول حو رقمه الدولي لا يمكن ان نغيره بترقيم 




27-03-2020 10:50 مساء
مشاهدة مشاركة منفردة [7]
ابراهيم الحداد
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 165
الجنس : ذكر
الدعوات : 1
قوة السمعة : 1389
الاعجاب : 17
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
السلام عليكم ورحمة الله
يعتمد طول النطاق على العمود الاول فى كل شيت
اذا كان هذا يسبب اغفال بعض النتائج يمكنك الدخول الى الماكرو و تغيير العمود الذى يعول
عليه نطاق الشيت الذى يستمد منه النتائج
اليك الملف بعد التعديل
 
 
 
  ALL.xlsm   تحميل xlsm مرات التحميل :(1)
الحجم :(51.079) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، ali mohamed ali، نجيب12،



28-03-2020 08:03 صباحا
مشاهدة مشاركة منفردة [8]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 492
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 3816
الاعجاب : 65
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
جرب هذا الكود مع اجراء التعديلات اللازمة بحيث تكتب اسم الفولدر الصحيح داخل الكود
 تحدد الصفحات والنطاقات المناسبة للنسخ

Option Explicit
'================================
Sub Copy_From_Other_Files()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim i As Integer
    Dim Arr()
    Dim My_WB As Workbook

    Set objFSO = CreateObject("Scripting.FileSystemObject")
'++++++++++++++++++++++++++++++++++++++++++
 'Replace (F:From net) with  the Name of Folder
    Set objFolder = objFSO.GetFolder("F:From net")
'+++++++++++++++++++++++++++++++++++++
i = 1
For Each objFile In objFolder.Files
If i > 10 Then Exit For 'You Can Change 10 to any number
ReDim Preserve Arr(1 To i)
Arr(i) = objFile.Path
i = i + 1
Next objFile
For i = LBound(Arr) To UBound(Arr)
Set My_WB = Workbooks.Open(Arr(i))
 
  '""""""""""""""""""""""""""""""""""""""
      'Write Here your code to copy sheets
      
      
  '""""""""""""""""""""""""""""""""""""""
  My_WB.Close , 0
Next
End Sub


أثارت هذه المشاركة إعجاب: YasserKhalil، ali mohamed ali، نجيب12، هاوي برمجه،



28-03-2020 06:25 مساء
مشاهدة مشاركة منفردة [9]
نجيب12
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 25-12-2019
رقم العضوية : 17178
المشاركات : 6
الدولة : الجزائر
الجنس : ذكر
تاريخ الميلاد : 1-7-1979
قوة السمعة : 12
الاعجاب : 1
 offline 
look/images/icons/i1.gif تجميع العديد من الملفات في ملف واحد
شكرا لكم جميعا 
تمت العملية بنجاح و تم الترحيل بشكل جيد جدا 
عدلت بالماكرو في رقم فقط arr,2 الى arr,1 و تم الترحيل 
اعتذر ان ازعجتكم اساتذتي الكرام 
Private Sub CommandButton4_Click()
Dim wbBook1 As Workbook, wbBook2 As Workbook
Dim Path As String, FilName As String
Dim Arr As Variant, Temp As Variant
Dim i As Long, LR As Long, j As Long, p As Long, LS As Long
If Me.ComboBox1 = "" Or Me.ComboBox2 = "" Or Me.ComboBox5 = "" Or Me.ComboBox8 = "" Or Me.ComboBox10 = "" Then
MsgBox "... الرجــــــاء اكمال كل البيانات ... !"
Exit Sub
End If
Path = UserForm2.ComboBox1.Value & UserForm2.ComboBox2.Value & "\"
FilName = Me.ComboBox5.Value
Dim ShName As String, ShName2 As String
ShName = Me.ComboBox10.Value
ShName2 = Me.ComboBox8.Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbBook1 = ThisWorkbook
Set wbBook2 = Workbooks.Open(Path & FilName)
Dim wsSheet1 As Worksheet
Dim wsSheet2 As Worksheet
Set wsSheet1 = wbBook1.Sheets(ShName)
Set wsSheet2 = wbBook2.Sheets(ShName2)
LR = wsSheet2.Range("A" & Rows.Count).End(xlUp).Row
LS = wsSheet1.Range("A" & Rows.Count).End(xlUp).Row
Arr = wsSheet2.Range("A2:R" & LR).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 1) <> "" Then
p = p + 1
For j = 1 To 18
Temp(p, j) = Arr(i, j)
Next
End If
Next
If p > 0 Then wsSheet1.Range("A" & LS + 1).Resize(p, UBound(Temp, 2)).Value = Temp
wbBook2.Close
wsSheet1.Columns("A:R").AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

أثارت هذه المشاركة إعجاب: YasserKhalil،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
تصدير مجموعة أوراق عمل إلى العديد من المصنفات إعتمادا على عمود أبو سجده
20 709 أبو سجده
طلب مساعدة في إيجاد دالة أو كود للبحث بعدة معايير في العديد من الشيتات في الملف Hatem Eissa
6 666 YasserKhalil
تطبيق إسلامي متكامل يتضمن العديد من الخصائص الدينية في حياة المسلم stenour
11 852 رضا عليم

الكلمات الدلالية
تجميع ، العديد ، الملفات ، واحد ،


 







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

الساعة الآن 11:18 مساء

أعلن هنا
أعلن هنا
أعلن هنا