اريد تجميع جميع الشيتات في شيت data

[رندة ابراهيم]

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

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

ASD.xlsx

[عبدالله بشير عبدالله]

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

12 ساعات مضت, رندة ابراهيم said:

وهناك طلاب يلتحقو فيما بعد

عند النحاق طلبة جدد اضغطي على زر نجميع البيانات  فيتم تحديث البيانات

الكود

Sub CombineSheets()
    Dim ws As Worksheet
    Dim mainSheet As Worksheet
    Dim dataRange As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim newRow As Long
    Dim i As Long
    Dim rowsArray() As Variant

    Set mainSheet = ThisWorkbook.Worksheets(1)
    
    mainSheet.Range("A3:FQ" & mainSheet.Cells(mainSheet.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    newRow = 3
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each ws In ThisWorkbook.Worksheets
        If ws.Index <> 1 Then
            Set dataRange = ws.Range("A3:FQ" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
            rowsArray = dataRange.Value
            For i = 1 To UBound(rowsArray, 1)
                lastRow = mainSheet.Cells(mainSheet.Rows.Count, "A").End(xlUp).Row + 1
                mainSheet.Cells(lastRow, 1).Resize(1, UBound(rowsArray, 2)).Value = Application.WorksheetFunction.Index(rowsArray, i, 0)
            Next i
        End If
    Next ws

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

تم تعديل فبراير 6, 2025 بواسطه عبدالله بشير عبدالله

[رندة ابراهيم]

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

[عبدالله بشير عبدالله]

عذرا  اليك الملف

ASD1.xlsb

 

تم تعديل فبراير 5, 2025 بواسطه عبدالله بشير عبدالله