طلب ترحيل بيانات من اكثر من شيت فى شيت واحد

[محمد نوح]

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

اخواني الكرام

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

وشكرا جزيلا ....🌷

الرواتب.xlsx

[محمد هشام.]

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

Sub MergeTotal()
    Dim WS As Worksheet, crWS As Worksheet, LastRow As Long, Irow As Long
    
    On Error Resume Next
    Set crWS = Sheets("total")
    On Error GoTo 0
    
    If crWS Is Nothing Then
    MsgBox " غير موجودة total ورقة ", vbInformation
        Exit Sub
    Else
     Application.ScreenUpdating = False
        crWS.Range("A2:O" & crWS.Rows.Count).Clear
    End If

    Irow = 2
    For Each WS In ThisWorkbook.Sheets
        If WS.Name <> crWS.Name Then
            LastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
            If LastRow >= 2 Then
                WS.Range("A2:O" & LastRow).Copy
                crWS.Cells(Irow, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
                Irow = crWS.Cells(crWS.Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If
    Next WS

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

الرواتب.xlsb