loop thru every sheet and filter out a specific name and create a new sheet

Looking for a way to loop thru every sheet in a WB and filter all the rows with a certain name and make a new sheet for them. I can do it for one but if the name appears on multiple sheets i need to append to the sheet already created.

So if you have "Mike" on sheet one create a sheet called Mike, copy the rows from the original sheet to a sheet called Mike and then look in the other sheets for that name. If it exists in another sheet copy those rows and append to the sheet you created called Mike.

I need to do this with multiple people the same way. A small sample workbook attached.

If the final order of the data on each User is not important

Code:

---

Option Explicit
Sub MergeSortSchred()
    Dim wsTemp As Worksheet, ws As Worksheet, wsName As Worksheet
    Dim rDest As Range, rSrc As Range, rSort As Range, rRow As Range
    Dim sPrevName As String
   
    Application.ScreenUpdating = False
   
    'add new temp
    Set wsTemp = pvtAddSheet("Temp")
   
   
    'merge all worksheets onto temp
    For Each ws In ActiveWorkbook.Worksheets
   
    Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp)
        If Not ws Is wsTemp Then
            Set rSrc = ws.UsedRange
            Set rSrc = Intersect(rSrc, Range(ws.Rows(2), ws.Rows(Rows.Count)))
            Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Offset(1, 0)
            rSrc.Copy rDest
        End If
    Next
   
   
    'sort temp by Balance in column 1 first
    Set rSort = wsTemp.Cells(1, 1)
    Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
    Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)
   
    With wsTemp.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rSort.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rSort
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


  'sort temp by name in column 2
    Set rSort = wsTemp.Cells(1, 1)
    Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
    Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)
    With wsTemp.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rSort.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rSort
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'loop down wsTemp, add sheet for new name, copy data over
    sPrevName = vbNullString
   
    For Each rRow In wsTemp.Cells(1, 1).CurrentRegion.Rows
        With rRow
            'some names in sampe are blank
            If Len(.Cells(2).Value) = 0 Then .Cells(2).Value = "No Name"
       
            If .Cells(2).Value <> sPrevName Then
                sPrevName = .Cells(2).Value
                Set wsName = pvtAddSheet(.Cells(2).Value)
                wsName.Cells(1, 1).Value = "Balance"
                wsName.Cells(1, 2).Value = "User"
            End If
               
            .Copy wsName.Cells(wsName.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
    Next
   
   
    Call pvtDeleteSheet("Temp")
           
    Application.ScreenUpdating = True
   
    MsgBox "Done"
           
End Sub

Private Sub pvtDeleteSheet(s As String)
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets(s).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
End Sub

Private Function pvtAddSheet(s As String) As Worksheet
   
    Call pvtDeleteSheet(s)
   
    Worksheets.Add.Name = s
    Set pvtAddSheet = ActiveSheet
End Function


---

Hi Paul. Thanks for that. Exactly what I need with a slight tweek. What all do I have to change the sort column to column M (13)?

Ive attached a sample of one line of the master sheet. The name is in Column M (13) I see you are also sorting by amount which would be col J. The page also has headers. The rest is exactly what I wanted. Thanks.

not tested, but you should just need to change the corresponding lines

it's .Header = xlNo because when I build Temp, I skip the headers on the input sheets so Temp has no headers

I sort by amount first since there are missing names

Code:

---

    'sort temp by balance in column 10 first
    Set rSort = wsTemp.Cells(1, 1)
    Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
    Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)

    With wsTemp.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rSort.Columns(10), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rSort
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'sort temp by name in column 13
    Set rSort = wsTemp.Cells(1, 1)
    Set rSort = Range(rSort, wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp))
    Set rSort = Intersect(rSort.EntireRow, wsTemp.UsedRange.EntireColumn)
    With wsTemp.Sort
        .SortFields.Clear
        .SortFields.Add Key:=rSort.Columns(13), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rSort
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


---

Hi Paul. Thanks. Trying to run this in Excel 2007. When you run it you get the following on

Code:

---

rSrc.Copy rDest

---

in the

Code:

---

'merge all worksheets onto temp    For Each ws In ActiveWorkbook.Worksheets
   
    Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp)
        If Not ws Is wsTemp Then
            Set rSrc = ws.UsedRange
            Set rSrc = Intersect(rSrc, Range(ws.Rows(2), ws.Rows(Rows.Count)))
            Set rDest = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Offset(1, 0)
            rSrc.Copy rDest
        End If
    Next

---

getting the error: object variable or with block variable no set. error

probably data dependant

Make and post a WB with 1 or 2 sheets that shows the issue

here you are

Sorry, I thought I posted this last night -- must not have

1. It was the Rules sheet since it was in a format not compatible with the macro, which assumed only data like in the first sample
I added a check for "Program Name" in A1

2. Caught some places that still referenced the columns in the first sampe (1 and 2) instead of 10 and 13

3. Added some formatting, status messages, and some cleanup

thanks Paul. Thats awesome. Solved