Sayfaları tek makro ile aktarma

[SadiSerdari]

Arkadaşlar aşağıdaki kodla sayfalardaki verileri Muhasebe sayfasına aktarıyorum. Ancak bunu kısa kodla nasıl yapabiliriz. Yardımcı olabilirseniz sevinirim. Veriler Özel olduğu için dosyayı ekleyemiyorum.Teşekkürler.

Sub sayfaAktar()

    Set WrkShtM = Worksheets("Muhasebe")
    Set WrkSht1 = Worksheets("710")
    Set WrkSht2 = Worksheets("720")
    Set WrkSht3 = Worksheets("730")
    Set WrkSht4 = Worksheets("740")
    Set WrkSht5 = Worksheets("750")
    Set WrkSht6 = Worksheets("760")
    Set WrkSht7 = Worksheets("770")
    Set WrkSht8 = Worksheets("780")
    
    Call Sil.Sil
    
'######################################## 710 ########################################

    mRow = 3
    snSat = WrkSht1.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 1

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht1.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
        
'######################################## 720 ########################################

    mRow = 3
    snSat = WrkSht2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht2.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
        
'######################################## 730 ########################################

    mRow = 3
    snSat = WrkSht3.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht3.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
    
'######################################## 740 ########################################

    mRow = 3
    snSat = WrkSht4.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht4.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
    
'######################################## 750 ########################################

    mRow = 3
    snSat = WrkSht5.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht5.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
    
'######################################## 760 ########################################

    mRow = 3
    snSat = WrkSht6.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 7

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht6.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
    
'######################################## 770 ########################################

    mRow = 3
    snSat = WrkSht7.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht7.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
    
'######################################## 780 ########################################

    mRow = 3
    snSat = WrkSht8.Cells(Rows.Count, 1).End(xlUp).Row + 1
    msnSat = WrkShtM.Cells(Rows.Count, 1).End(xlUp).Row + 4

        For Sat = msnSat To snSat + msnSat
            For Sut = 1 To 84
                WrkShtM.Cells(Sat, Sut).Value = WrkSht8.Cells(mRow, Sut).Value
                WrkShtM.Rows("3:" & Sat).NumberFormat = "#,##0.00"
                
            Next
            mRow = mRow + 1
        Next
        
    WrkShtM.Range("A" & Sat - 4, "CF" & Sat - 4).Interior.ColorIndex = 3
    WrkShtM.Range("A" & Sat - 2, "CF" & Sat - 2).Interior.ColorIndex = 1
 
End Sub