كود ترحيل جميع صفحات الملف بصفحة واحدة

[مهند محسن]

السلام عليكم أحبائى الأعزاء .. رجاءا من سيادتكم التكرم على مساعدتى بإيجاد كود ترحيل جميع صفحات الملف الى صفحة Total بالشكل الموجود بهذه الصفحة ولكم جزيل الشكر وبارك الله فى جهودكم جميعا

 

The Safe.xlsb

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

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

جرب  هذا الكود

Sub MergeSheets_Total()
    Dim ws As Worksheet, wsTotal As Worksheet
    Dim i As Long, destRow As Long
    Dim dateValue As Variant
    Dim r As Long, lastDataRow As Long
    Dim sheetName As String
    
    On Error Resume Next
    Set wsTotal = ThisWorkbook.Sheets("TOTAL")
    On Error GoTo 0
    If wsTotal Is Nothing Then
        MsgBox "لم يتم العثور على الشيت TOTAL", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    wsTotal.Range("A3:F320").ClearContents
    
    destRow = 3
    
    For i = 1 To 31
        sheetName = Format(i, "00")
        
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetName)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            lastDataRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If lastDataRow >= 4 Then
                dateValue = ws.Range("B1").Value
                
                For r = 4 To lastDataRow
                    If Trim(ws.Cells(r, "A").Value) <> "" Then
                        wsTotal.Cells(destRow, "B").Resize(1, 5).Value = ws.Cells(r, "A").Resize(1, 5).Value
                        wsTotal.Cells(destRow, "A").Value = dateValue
                        destRow = destRow + 1
                    End If
                Next r
            End If
        End If
        Set ws = Nothing
    Next i
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

The Safe1.xlsb

 

[مهند محسن]

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

بالفعل عمل رائع هو المطلوب بالضبط شاكر جدا جهود سيادتكم