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

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


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





تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر

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


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


14-01-2022 10:25 صباحا
khaled alborene
عضو متميز
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 16
المشاركات : 834
الدولة : الاردن
الجنس : ذكر
تاريخ الميلاد : 9-9-1990
الدعوات : 2
يتابعهم : 10
يتابعونه : 11
قوة السمعة : 988
عدد الإجابات: 1
 offline 

اساتذتي الكرام 
في الملفات المرفقة احتاج الى كود يوضع في ملف تجميع البيانات يقوم بجلب الشيت من ملف راتب شهر 1 وراتب شهر 2 ووضعها بملف تجميع البيانات بحيث تكون كل شيت منفصلة عن الاخرى ولا يقوم بوضعها جميعها في شيت واحدة
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  جمع البيانات.rar   تحميل rar مرات التحميل :(9)
الحجم :(24.919) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
السلام عليكم نبدأ بها أي موضوع
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim wb As Workbook, ws As Worksheet, sPath As String, fn As String
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> "Sheet1" Then ws.Delete
        Next ws
        Application.DisplayAlerts = True
        sPath = ThisWorkbook.Path & "\"
        fn = Dir(sPath & "*.xls*")
        Do While fn <> ""
            If fn <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(sPath & fn, , True)
                wb.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Replace(fn, ".xlsx", "")
                wb.Close False
            End If
            fn = Dir
        Loop
        Application.Goto ThisWorkbook.Sheets("Sheet1").Range("A1")
    Application.ScreenUpdating = True
End Sub
عرض الإجابة




14-01-2022 10:27 صباحا
مشاهدة مشاركة منفردة [1]
khaled alborene
عضو متميز
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 16
المشاركات : 834
الدولة : الاردن
الجنس : ذكر
تاريخ الميلاد : 9-9-1990
الدعوات : 2
يتابعهم : 10
يتابعونه : 11
قوة السمعة : 988
عدد الإجابات: 1
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
مرفق صورة بشكل نتيجة البيانات 

14-01-2022 10:53 صباحا
مشاهدة مشاركة منفردة [2]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
السلام عليكم نبدأ بها أي موضوع
جرب الكود التالي عله يفي بالغرض إن شاء الله
Sub Test()
    Dim wb As Workbook, ws As Worksheet, sPath As String, fn As String
    Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name <> "Sheet1" Then ws.Delete
        Next ws
        Application.DisplayAlerts = True
        sPath = ThisWorkbook.Path & "\"
        fn = Dir(sPath & "*.xls*")
        Do While fn <> ""
            If fn <> ThisWorkbook.Name Then
                Set wb = Workbooks.Open(sPath & fn, , True)
                wb.Worksheets(1).Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
                ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Replace(fn, ".xlsx", "")
                wb.Close False
            End If
            fn = Dir
        Loop
        Application.Goto ThisWorkbook.Sheets("Sheet1").Range("A1")
    Application.ScreenUpdating = True
End Sub

14-01-2022 06:32 مساء
مشاهدة مشاركة منفردة [3]
khaled alborene
عضو متميز
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 16
المشاركات : 834
الدولة : الاردن
الجنس : ذكر
تاريخ الميلاد : 9-9-1990
الدعوات : 2
يتابعهم : 10
يتابعونه : 11
قوة السمعة : 988
عدد الإجابات: 1
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
السلام عليكم استاذ ياسر
حل رائع قام بالمطلوب على اكمل وجه
رحم الله والدك واسكنه فسيح جنانه
بارك الله فيك

14-01-2022 07:26 مساء
مشاهدة مشاركة منفردة [4]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
وعليكم السلام أخي الكريم خالد
ومشكور على دعائك الطيب لأبي غفر الله له وتغمده برحمته التي وسعت كل شيء وأدخله الفردوس الأعلى من الجنة.

14-01-2022 07:28 مساء
مشاهدة مشاركة منفردة [5]
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 277
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
عوداً أحمد استاذنا الاستاذ ياسر ونسأل الله أن يغفر للوالد وأن يرحمه وأن يسكنه فسيح جناته وموتانا أجمعين
 

15-01-2022 12:23 صباحا
مشاهدة مشاركة منفردة [6]
hassona229
مشرف عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2018
رقم العضوية : 9257
المشاركات : 808
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 13-9-1980
يتابعهم : 0
يتابعونه : 11
قوة السمعة : 4330
عدد الإجابات: 113
 offline 
look/images/icons/i1.gif تجميع الشيتات من ملفات مختلفة ووضعها في ملف اخر
اللهم اغفر للوالد الكريم ويجعل ما تقوم به اخى الغالى ياسر ابو البراء في ميزان حسناتك وحسناته يوم القيامه


الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
تجميع ، الشيتات ، ملفات ، مختلفة ، ووضعها ،


 










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

الساعة الآن 06:43 مساء