Create One Grouped By Sheet

[juan4412]

I have been utilizing this VBA that would
1) Take a value from cell Sheet1!E3
2) Filter the data on Sheet2 to the value in E3
3) Create a worksheet, and name it the value in Sheet1!E3
4) Copy the filtered data from Sheet2 to the new sheet
5) Group the copied data
6) Add Totals to the bottom of the newly grouped data

This works exactly as it should for an individual worksheet, however I now need to be able to pass in an array of values and have each of those listed on one sheet grouped under each other instead of one worksheet per. How would I modify this code so that instead of an individual worksheet for ?

Sub CreateOneSheet()
Dim namearray As Variant, I As Long
namearray = Split(Range("E3").Value,";")
  MakeSheets(namearray)
End SUb


Sub MakeSheets(filterBy As String)
Dim rLastCell As Range
Sheets("Sheet2").Select


Sheets("Sheet1").Select
Range("SQLQuery[[#Headers],[C]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("SQLQuery").Range.AutoFilter Field:=1, Criteria1:=filterBy


Set rngCopy = ActiveSheet.UsedRange
Set rngCopy = rngCopy.SpecialCells(XlCellType.xlCellTypeVisible)
ThisWorkbook.Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = filterBy
rngCopy.Copy ThisWorkbook.Worksheets(filterBy).Cells(1, 1)
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select


Sheets("Sheet1").Select
Selection.AutoFilter
Sheets(filterBy).Select


Set rLastCell = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
Range("A2:A" & rLastCell.Row).Rows.Group
ActiveSheet.Outline.ShowLevels RowLevels:=1


With ActiveSheet
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastrow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      LookAt:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    Else
        lastrow = 1
    End If
End With
Range("D" & lastrow + 1).FormulaR1C1 = "=SUM(R[-" & lastrow & "]C:R[-1]C)"
Range("D" & lastrow + 1 & ":M" & lastrow + 1).FillRight
Range("A" & lastrow + 1).FormulaR1C1 = filterBy & " Totals"


Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select


End Sub

Also here is a link to the workbook that shows how the data will be entered on Sheet1 and how I want it displayed on Sheet2 (I only used 2 for the array, but it shoudl get the point across)

http://<a href=http://www.filedropper.com/book1_2><img src=http://www.filedropper.com/download_button.png width=127 height=145 border=0/></a><br /><div style=font-size:9px;font-family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;> <a href=http://www.filedropper.com >file backup online</a></div>