Summarize data from multiple worksheets

**jarssonn** · 06-28-2010, 11:55 AM

Hi all excel experts,

I am in process of preparing training records file but unfortunately I get stucked.
My file will contain about 50 worksheets - one for each of the employees named as employee name (every worksheet will be the same format).
What I will need is a macro which will pull out data from individual training record sheets into the summary sheet.
Sounds simple but is not simple for me - I hope somebody will help me with that.
I have uploaded sample workbook so it will be easier for somebody who will decide to give it a try.

Thanks in advance for any help.

**Leith Ross** · 06-28-2010, 09:54 PM

Hello jarssonn,

This macro has been added to the attached workbook. To run the macro, click the button "Summarize" at the top left of the "Summary Sheet".

'Written: June 29, 2010
'Author:  Leith Ross

Sub InternalSummary()

  Dim LastRow As Long
  Dim R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SumWks As Worksheet
  Dim Wks As Worksheet
  
    R = 2           'Starting row on the Summary Sheet
    LastRow = 25    'Last row of Internal Training
    Set SumWks = Worksheets("Summary Sheet")
    
      For Each Wks In Worksheets
        If Wks.Name <> SumWks.Name And Wks.Name <> "CATS" Then
          Set Rng = Wks.Range("A10:I10")
          Set RngEnd = Wks.Cells(LastRow, Rng.Column).End(xlUp)
            If RngEnd.Row >= Rng.Row Then
              Set Rng = Wks.Range(Rng, RngEnd)
              SumWks.Cells(R, "A") = Wks.Cells(2, "B")   'Name
              SumWks.Cells(R, "B") = Wks.Cells(3, "B")   'Current Role
              SumWks.Cells(R, "C") = Wks.Cells(4, "B")   'Site
              SumWks.Cells(R, "D").Resize(Rng.Rows.Count, 9).Value = Rng.Value
              R = R + Rng.Rows.Count
            End If
        End If
      Next Wks
      
End Sub

**jarssonn** · 06-29-2010, 03:19 AM

Hi! Fantastic work - many thanks. Just one simple thing - is this possible that Name, Current Role and Site appears on every line not just in the first one for courses of the same person? This is needed for filtering purpose.
Many thanks again!

**Leith Ross** · 06-29-2010, 12:47 PM

Hello jarssonn,

I made the changes you wanted. Here is the revised macro. This has been added to the attached workbook.

'Written: June 28, 2010
'Updated: June 29, 2010 - Extended Name, Current Role, and Site information to all cells
'Author:  Leith Ross

Sub InternalSummary()

  Dim LastRow As Long
  Dim R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SumWks As Worksheet
  Dim Wks As Worksheet
  
    R = 2           'Starting row on the Summary Sheet
    LastRow = 25    'Last row of Internal Training
    Set SumWks = Worksheets("Summary Sheet")
    
      For Each Wks In Worksheets
        If Wks.Name <> SumWks.Name And Wks.Name <> "CATS" Then
          Set Rng = Wks.Range("A10:I10")
          Set RngEnd = Wks.Cells(LastRow, Rng.Column).End(xlUp)
            If RngEnd.Row >= Rng.Row Then
              Set Rng = Wks.Range(Rng, RngEnd)
              SumWks.Cells(R, "A") = Wks.Cells(2, "B")   'Name
              SumWks.Cells(R, "B") = Wks.Cells(3, "B")   'Current Role
              SumWks.Cells(R, "C") = Wks.Cells(4, "B")   'Site
              SumWks.Cells(R, "D").Resize(Rng.Rows.Count, 9).Value = Rng.Value
                SumWks.Range("A" & R & ":C" & R + Rng.Rows.Count - 1).Value = _
                  WorksheetFunction.Transpose(Wks.Range("B2:B4").Value)
              R = R + Rng.Rows.Count
            End If
        End If
      Next Wks
      
End Sub