Adding selected rows from several worksheets to a summary worksheet

  • Thread starter Thread starter John
  • Start date Start date
J

John

I have student information from 30 schools on 30 separate
worksheets. Each school can have up to 35 students. I'd
like to build a list on a separate worksheet of students
from all schools with a specific criteria. How can I do
this?
Thanks,
John
 
Use a macro to combine all the sheets and then run a Pivot table against the
consolidated data to pull out what you need, OR simply use Data Filter /
Autofilter on the summarised data sheet. The following routine will consolidate
your data for you assuming that all sheets have a consistent structure:-

Sub SummaryCombineMultipleSheets()

Dim SumWks As Worksheet
Dim sd As Worksheet
Dim sht As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim StRow As Long

HeadRow = InputBox("What row are the Sheet's data headers in?")
DataRow = HeadRow + 1

On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary Sheet").Delete
Application.DisplayAlerts = False
On Error GoTo 0

Set SumWks = Worksheets.Add

With SumWks
.Move Before:=Sheets(1)
.Name = "Summary Sheet"
Sheets(2).Rows(HeadRow).Copy .Range("1:1")
Columns("A:A").Insert Shift:=xlToRight
Range("A1").Value = "INDEX"
End With

With Sheets(2)
ColW = .UsedRange.Column - 1 + .UsedRange.Columns.Count
End With

For sht = 2 To ActiveWorkbook.Sheets.Count
Set sd = Sheets(sht)
lrow1 = SumWks.Cells(Rows.Count, "B").End(xlUp).Row
lrow2 = sd.Cells(Rows.Count, "B").End(xlUp).Row
sd.Activate
sd.Range(Cells(DataRow, 1), Cells(lrow2, ColW)).Copy SumWks.Cells(lrow1 + 1,
2)
SumWks.Cells(lrow1 + 1, 1).Resize(lrow2 - (DataRow - 1), 1).Value = sd.Name
Next sht

SumWks.Activate

End Sub
 
Back
Top