Excel - Copy rows to total page

December 2016




Issue


I have an Excel spreadsheet with 13 worksheets. The first 12 worksheets are January through December. The 13th worksheet is a total. Each worksheet has identical columns and rows.

In all worksheets, there are about 10 columns like Date, Name, Address, Account Number, Department, Employee Name, etc...

What I am trying to do is enter the information in each monthly worksheet and have the data I'm entering automatically copied to the total worksheet. The total worksheet would contain all the data entered. I'd have a monthly breakdown, but the total page contains all transactions.

I have all the worksheets set up, but can't come up with the code to do the copy. Any suggestions please?

Solution


Try this. Of course make sure you make a backup of original file before testing
Assumptions.
  • 1. The sheets are names Jan, Feb, ....
  • 2. The Master sheet is called Master
  • 3. The column 1 does not have blank value (it is used to find the max number of rows)
  • 4. There are no more than 11 columns
  • 5. Master sheet already have header row.


Sub copyData() 

    Dim maxRows As Long 
    Dim maxCols As Integer 
    Dim conSheet As String 'consolidated sheet name 
    Dim lConRow As Long  
    Dim maxRowCol As Integer 'used to find max number of rows 
     
    maxCols = 11 
    months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec") 
     
    maxRowCol = 1 
    conSheet = "Master" 
     
     
    Sheets(conSheet).Select 
     
    Range("A2").Select 
    Cells(65536, 256).Select 
    Selection.End(xlDown).Select 
     
    maxRows = Selection.Row 
     
    Range("A2", Selection).Select 
    Selection.ClearContents 
     
    lConRow = 2 
     
    For x = 0 To Sheets.Count - 2 

        Sheets(months(x)).Select 

        If ActiveSheet.AutoFilterMode Then 
            Cells.Select 
            Selection.AutoFilter 
        End If 

        Cells.Select 
         
        Dim lastRow As Long 
         
        lastRow = Cells(maxRows, maxRowCol).End(xlUp).Row 

        If (lastRow > 1) Then 

            Range(Cells(2, 1), Cells(lastRow, maxCols)).Select 
            Selection.Copy 

            Sheets(conSheet).Select 
            Cells(lConRow, 1).Select 
            Selection.PasteSpecial 

            lConRow = Cells(maxRows, maxRowCol).End(xlUp).Row 
            lConRow = lSummaryRow + 1 

        End If 


        If ActiveSheet.Name = "Dec" Then Exit Sub 

    Next 
     
End Sub

Note


Thanks to rizvisa1 for this tip on the foru.

Related :

This document entitled « Excel - Copy rows to total page » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.