طلب مساعدة في دمج شيتات في شيت واحدة

[kodatnet]

السلام عليكم ورحمة الله

 

لدي ملف اكسل يحتوي على عدة صفحات

الصفحة الأولى

 

الصفحة الثانية

 

أرغب في جعل جميع الشيتات تظهر في شيت واحد لا اريد جمع ارقام  اريدها بنفس البيانات

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

[kodatnet]

اذا تحتاجون ارفع الملف ابلغوني

[أبوعيد]

نعم ارفع الملف واشرح فيه طلبك

[kodatnet]

ارفقت مثال على الملف بالمرفقات

 

هذ مثال على الملف

احتاج البيانات التي في الشيت Sheet1-Sheet4

 

تنتقل الى الشيت Total

 

اهم البيانات التي احتاجها

اسم الطالب

الرقم الاكاديمي

المادة

 

CS_StudentRemainingCourses.xlsx

تم تعديل أكتوبر 23, 2021 بواسطه kodatnet
اعادة رفع ملف

[حسونة حسين]

وعليكم السلام ورحمه الله وبركاته

اخى الكريم ما هو الشكل المتوقع لوضع البيانات في صفحه total

صمم نموزج لشكل البيانات وليكن لعدد ٢ طالب لتتضح الرؤيه

 

[kodatnet]

هذا الشكل المتوقع لصفحة Total

 

واخترت بيانات شيت 2و 3  كمثال

url=https://mrkzgulfup.com/][/url]

بمعنى جميع البيانات التي احتاجها تكون في Total

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

 

واعتذر عملتها بالجوال لاني خارج البيت

تم تعديل أكتوبر 23, 2021 بواسطه kodatnet

[FaHaD626]

مساء الخير 

 

جرب الملف المرفق 

 

وجرب تدخل شيت جديد ببيانات جديدة وبعدين روح لشيت اسم Query1 واعمل تحديث عالجدول الاخضر كليك يمين تحديث او من فوق من Query تضغط تحديث

 

ملاحظة 

 

حاول دائما تستخدم الجداول لتسهيل عملية البرمجة والبحث

 

ارجو ان يكون الملف هو ما طلبت 

دمج.xlsx

[حسونة حسين]

تفضل اخى الكريم

Sub Test()
Dim SH As Worksheet, WS As Worksheet, SHLR As Long, WSLR As Long, CEL As Range
Application.DisplayAlerts = False
Application.EnableEvents = False
Set WS = ThisWorkbook.Worksheets("Total")
For Each SH In Worksheets
    If SH.Name <> "Total" Then
        With SH
        SHLR = SH.Cells(Rows.Count, 4).End(xlUp).Row + 1
            For Each CEL In SH.Range("D14:D" & SHLR)
                If CEL.Value <> Empty Then
                WSLR = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row + 1
                WS.Range("A" & WSLR) = SH.Range("I14")
                WS.Range("B" & WSLR) = SH.Range("L14")
                WS.Range("C" & WSLR) = CEL.Value
                End If
            Next CEL
        End With
    End If
Next SH
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

CS_StudentRemainingCourses.xlsm

CS_StudentRemainingCourses-1.xlsm

تم تعديل أكتوبر 24, 2021 بواسطه hassona229
إرفاق ملف

[kodatnet]

اخي hassona229

نزلت الملف وهو نفس المطلوب

 

ولكن المشكلة عندما اغير اي خلية في الشيت 1 مثلا لا ينعكس التغيير على الشيت Total

[حسونة حسين]

اخى في الله

في الملف كود اسمه test

اكتب التغيرات التى تريدها في الملفات ثم شغل الكود 

[kodatnet]

اخي hassona229

 

للاسف لا افهم كثير في الاكواد اللي اعرفه نسخ ولصق الكود

 

في وضعي ما المتغيرات التي تقصد اكتبها

[حسونة حسين]

بعد ما تنسخ الكود اضغط على f5 ليتم تشغيله

او اعمل زر  

انظر للمشاركه السابقه اخى الكريم حمل الملف المرفق مره اخرى

 

 

تم تعديل أكتوبر 24, 2021 بواسطه hassona229

[kodatnet]

طبقت الخطوات ويظهر لي عند ضغط الزر

 

 

وعند الضغط على زر Debug يظهر التالي

 

تم تعديل أكتوبر 24, 2021 بواسطه kodatnet

[حسونة حسين]

اخى نزل الملف مره اخرى تم تعديله

او انسخ الكود مره اخرى 

Sub Test()
Dim SH As Worksheet, WS As Worksheet, SHLR As Long, WSLR As Long, CEL As Range
Application.DisplayAlerts = False
Application.EnableEvents = False
Set WS = ThisWorkbook.Worksheets("Total")
For Each SH In Worksheets
    If SH.Name <> "Total" Then
        With SH
        SHLR = SH.Cells(Rows.Count, 4).End(xlUp).Row + 1
            For Each CEL In SH.Range("D14:D" & SHLR)
                If CEL.Value <> Empty Then
                WSLR = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row + 1
                WS.Range("A" & WSLR) = SH.Range("I14")
                WS.Range("B" & WSLR) = SH.Range("L14")
                WS.Range("C" & WSLR) = CEL.Value
                End If
            Next CEL
        End With
    End If
Next SH
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[kodatnet]

شكرا اخب hassona229

 

هذا هو المطلوب و الذي كنت اريده بعد تعديلك للكود اصبحت الأمور تمام

 

اكرر شكري لك و للاخ FaHaD626 الذي تفاعل مع الموضوع

[حسونة حسين]

الحمد لله الذي بنعمته تتم الصالحات