• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

summarize data from worksheets

Hi All - I need to summarize the data from all the worksheets in a workbook (each worksheet represents 1 company data). Can you please help me with the code.

- structure of data is same in all worksheets
- data headers are in row six of each worksheet
- data starts from row 7 in each worksheet
- rows should be combined from each worksheet (company) upto the row upto the last value in column F or G

I want to combine data from all worksheets so I can create dashboard based on combined data for all the companies.

The summary worksheet will look like as below with combined data from all worksheets.

59380
Thanks
 

Attachments

chirayu

Well-Known Member
Add in a sheet called "Master". Add the headers in. Then use code below

Code:
Sub wksCombine()

Dim ws As Worksheet ' For copying
Dim PstRow As String 'Find paste row in Master sheet
Dim Lstrow As String 'Find last Row in Data entry sheet

For Each ws In ActiveWorkbook.Worksheets
   
    With Worksheets("Master")
        PstRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
    End With
       
        If ws.Name Like "Data entry*" Then
           
            With Worksheets(ws.Name)
                Lstrow = .Cells(.Rows.Count, "B").End(xlUp).Row
                .Range("A7:G" & Lstrow).Copy
                Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteValues
                Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
       
        End If
       
Next ws

End Sub
 
Add in a sheet called "Master". Add the headers in. Then use code below

Code:
Sub wksCombine()

Dim ws As Worksheet ' For copying
Dim PstRow As String 'Find paste row in Master sheet
Dim Lstrow As String 'Find last Row in Data entry sheet

For Each ws In ActiveWorkbook.Worksheets
  
    With Worksheets("Master")
        PstRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
    End With
      
        If ws.Name Like "Data entry*" Then
          
            With Worksheets(ws.Name)
                Lstrow = .Cells(.Rows.Count, "B").End(xlUp).Row
                .Range("A7:G" & Lstrow).Copy
                Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteValues
                Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
      
        End If
      
Next ws

End Sub
Many thanks.

Can you add "Master" worksheet and headers from "row 6" to Master ws.
 

chirayu

Well-Known Member
Code:
Sub wksCombine()

Application.ScreenUpdating = False

Dim ws As Worksheet ' For copying
Dim PstRow As String 'Find paste row in Master sheet
Dim Lstrow As String 'Find last Row in Data entry sheet

'Clean + Format Master sheet
With Worksheets("Master")
    
    'Clear existing data in Master sheet
    .Cells.Delete
    
    'Add headers in Master sheet
    .Range("A1") = "Enity code"
    .Range("B1") = "Year"
    .Range("C1") = "Month"
    .Range("D1") = "Quarter"
    .Range("E1") = "Account"
    .Range("F1") = "QAR budget"
    .Range("G1") = "QAR actual"
    
    'Format Headers
    With .Range("A1:G1")
        .Interior.Color = RGB(191, 191, 191)
        .Borders.LineStyle = xlContinuous
        .Font.Bold = True
    End With
    
End With
    
    'Copy information to Master sheet
    For Each ws In ActiveWorkbook.Worksheets
      
       'Figure out paste row in Master Sheet
        With Worksheets("Master")
            PstRow = .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Row
        End With
          
           'Loop through Data Entry sheets
            If ws.Name Like "Data entry*" Then
              
                With Worksheets(ws.Name)
                    Lstrow = .Cells(.Rows.Count, "B").End(xlUp).Row
                    .Range("A7:G" & Lstrow).Copy
                    Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteValues
                    Worksheets("Master").Range("A" & PstRow).PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With
          
            End If
          
    Next ws

Application.ScreenUpdating = True

End Sub
 
Top