Well "ALL SHEETS" is a dangerous phrase. You mean "all the sheets I want to parse from".

This version has an array added where you can list all the sheet names to parse data from.

Option Explicit

Sub ParseItems()
'Author:    Jerry Beaucaire
'Date:      11/11/2009
'Summary:   Based on selected column, data is filtered to individual sheets
'           Creates sheets and sorts sheets alphabetically in workbook
'           6/10/2010 - added check to abort if only one value in vCol
'           7/22/2010 - added ability to parse numeric values consistently
'           10/16/2010 - add ability to parse multiple data sheets
Dim LR As Long, Itm As Long, vCol As Long
Dim MyCount As Long, RowsCount As Long, TmpCount As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, Oops As Boolean

Application.ScreenUpdating = False

'Column to evaluate from, column A = 1, B = 2, etc.
   vCol = 1
 
'Sheet(s) with data to parse
For Each ws In Sheets(Array("Data", "Data2", "Data3"))

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"
   
'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
   RowsCount = RowsCount + LR - 1

'Get a temporary list of unique values from column A
    ws.Columns(vCol).SpecialCells(xlConstants).AdvancedFilter _
        Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), _
        Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

'Put list into an array for looping
'(values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE1:EE" _
        & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
'The array includes the title cell, so we start at the second value in the array
'In case values are numerical, we convert them to text with ""
    For Itm = 2 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm) & ""
    
        If Not Evaluate("=ISREF('" & MyArr(Itm) & "'!A1)") Then    'create sheet if needed
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyArr(Itm) & ""
        Else                                                      'clear sheet if it exists
            Sheets(MyArr(Itm) & "").Move After:=Sheets(Sheets.Count)
        End If
    
        If Sheets(MyArr(Itm) & "").Range("A1") <> "" Then
            TmpCount = Sheets(MyArr(Itm) & "") _
                .Range("A" & Rows.Count).End(xlUp).Row - 1
                ws.Range("A" & Range(vTitles).Resize(1, 1) _
                .Row & ":A" & LR).Offset(1).EntireRow.Copy _
                    Sheets(MyArr(Itm) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)
            MyCount = MyCount + Sheets(MyArr(Itm) & "") _
                .Range("A" & Rows.Count).End(xlUp).Row - 1 - TmpCount
        Else
            ws.Range("A" & Range(vTitles).Resize(1, 1) _
                .Row & ":A" & LR).EntireRow.Copy Sheets(MyArr(Itm) & "").Range("A1")
            MyCount = MyCount + Sheets(MyArr(Itm) & "") _
                .Range("A" & Rows.Count).End(xlUp).Row - 1
        End If
        
    'add total
        With Sheets(MyArr(Itm) & "").Range("B" & Rows.Count).End(xlUp).Offset(1)
            .Value = "Balance:"
            .HorizontalAlignment = xlRight
            .Offset(, 1).Formula = "=SUM(D:E)"
            .Resize(1, 2).Font.Bold = True
        End With
 
        
        ws.Range(vTitles).AutoFilter Field:=vCol
        Sheets(MyArr(Itm) & "").Columns.AutoFit
    Next Itm
    
'Cleanup
    ws.AutoFilterMode = False
Next ws

'Final response
    MsgBox "Rows with data: " & RowsCount & vbLf & "Rows copied to other sheets: " _
                & MyCount & vbLf & "Hope they match!!"

Application.ScreenUpdating = True
End Sub