Data Distribution with multiple sheets

Question

I am using below code to distribute data form 1 sheet to 1 sheet of another workbook.

Is it possible to distribute the same as multiple sheets to multiple sheets of another wordbook!!!

Sample File Link : http://1drv.ms/1eEMmug or http://goo.gl/Co976i

Option Explicit

Sub split()

'Step 1: Declare your Variables

    Dim MySheet As Worksheet

    Dim MyRange As Range

    Dim UList As Collection

    Dim UListValue As Variant

    Dim i As Long, N As Workbook, Ns As Worksheet, c As Integer

Application.ScreenUpdating = False

 c = Application.InputBox("Pls Enter Column No like as 1 for A,2 for B", "Column to filter", , , , , , 1)

'Step 2:  Set the Sheet that contains the AutoFilter

   Set MySheet = ActiveSheet

'Step 3: If the sheet is not auto-filtered, then exit

   If MySheet.AutoFilterMode = False Then

        Exit Sub

    End If

'Step 4: Specify the Column # that holds the data you want filtered

   Set MyRange = Range(MySheet.AutoFilter.Range.Columns(c).Address)

'Step 5: Create a new Collection Object

   Set UList = New Collection

'Step 6:  Fill the Collection Object with Unique Values

   On Error Resume Next

    For i = 2 To MyRange.Rows.Count

    UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))

    Next i

    On Error GoTo 0

'Step 7: Start looping in through the collection Values

   For Each UListValue In UList

'Step 8: Delete any Sheets that may have bee previously created

       On Error Resume Next

        Application.DisplayAlerts = False

        Sheets(CStr(UListValue)).Delete

        Application.DisplayAlerts = True

        On Error GoTo 0

'Step 9:  Filter the Autofilter to macth the current Value

       MyRange.AutoFilter Field:=c, Criteria1:=UListValue

'Step 10: Copy the AutoFiltered Range to new Workbook

       MySheet.AutoFilter.Range.Copy

       Set N = Workbooks.Add(xlWBATWorksheet)

       Set Ns = N.Worksheets(1)

       Ns.Paste

       ' Worksheets.Add.Paste

        'ActiveSheet.Name = UListValue 'Left(Replace(UListValue, "/", ""), 30)

        Ns.Name = MySheet.Name 'AlphaNumericOnly(UListValue.Value)

        Cells.EntireColumn.AutoFit

        N.SaveAs Filename:=Application.ThisWorkbook.Path & "" & AlphaNumericOnly(UListValue.Value) ', FileFormat:=xlExcel12 _

        , CreateBackup:=False

        N.Close False

'Step 11: Loop back to get the next collection Value

   Next UListValue

'Step 12: Go back to main Sheet and removed filters

   MySheet.AutoFilter.ShowAllData

    MySheet.Select

Application.ScreenUpdating = True

  End Sub

Answer 1

I have made it possible!!!

Option Explicit

Sub Split_Multiple_Sheets_in_A_Workbook()

    Dim MySheet As Worksheet, ws As Worksheet

    Dim MyRange As Range, i As Long, N As Workbook

    Dim UList As Collection, UListValue As Variant, c As Integer

Application.ScreenUpdating = False

 c = Application.InputBox("Pls Enter Column No like as 1 for A,2 for B", "Column to filter", , , , , , 1)

    Set MySheet = ActiveSheet

    If MySheet.AutoFilterMode = False Then Exit Sub

        Set MyRange = Range(MySheet.AutoFilter.Range.Columns(c).Address)

            Set UList = New Collection

            On Error Resume Next

                For i = 2 To MyRange.Rows.Count

                    UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))

                Next i

            On Error GoTo 0

            For Each UListValue In UList

                Set N = Workbooks.Add(xlWBATWorksheet)

                    For Each ws In ThisWorkbook.Sheets

                        ws.UsedRange.AutoFilter c, UListValue

                        'ws.Range(ws.AutoFilter.Range.Address).AutoFilter c, UListValue

                        With N

                            ws.AutoFilter.Range.Copy

                            Sheets.Add().Name = ws.Name

                            Sheets(ws.Name).Paste

                            Cells.EntireColumn.AutoFit

                        End With

                    Next ws

                    N.SaveAs Filename:=Application.ThisWorkbook.Path & "" & AlphaNumericOnly(UListValue.Value) ', FileFormat:=xlExcel12 _

                , CreateBackup:=False

                N.Close False

            Next UListValue

   MySheet.AutoFilter.ShowAllData

   MySheet.Select

Application.ScreenUpdating = True

End Sub

Answer 2

Data Distribution with multiple sheets may read as Data Split with multiple sheets. 

If link doesn't work try this https://dl.dropboxusercontent.com/u/97045285/Distribution.xlsb