• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Data Distribution with multiple sheets [Split Excel]

Good day Deepak

Your links do not work and will not open on download due to VBA!! Will put members off.

19 views and no help, do you think you would attract more viewers/help if you used the forum upload and let members view your worksheet within the forum?
 
Wow! I did it....
Code:
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 long
  
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
 
Back
Top