Results 1 to 3 of 3

Thread: Split Workbook In To Multiple Files Using Advanced Filter And Unique Values

  1. #1
    Junior Member
    Join Date
    Aug 2011
    Posts
    10
    Rep Power
    0

    Split Workbook In To Multiple Files Using Advanced Filter And Unique Values

    Hi,

    i have a code which creates individual workbooks using advance filter for one tab ..but i am having another tab same action is to be repeated but both sheets should be placed in one workbook cost center wise.

    My code is as follows for LOAD DATA (Tab).

    Code:
    Sub DistributeRows()
        Dim wbNew As Workbook
        Dim wsData As Worksheet
        Dim wsCrit As Worksheet
        Dim wsNew As Worksheet
        Dim rngCrit As Range
        Dim LastRow As Long
         
        Set wsData = Worksheets("LOAD DATA")
        Set wsCrit = Worksheets.Add
         
        LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
         
        wsData.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
         
        Set rngCrit = wsCrit.Range("A2")
        While rngCrit.Value <> ""
            Set wsNew = Worksheets.Add
            wsData.Range("A1:AH" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
            wsNew.Name = rngCrit
            wsNew.Copy
            Set wbNew = ActiveWorkbook
            wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit & "-" & Format(Date, "dd mmm yy")
            wbNew.Close SaveChanges:=True
            Application.DisplayAlerts = False
            wsNew.Delete
            rngCrit.EntireRow.Delete
            Set rngCrit = wsCrit.Range("A2")
        Wend
         
        wsCrit.Delete
        Application.DisplayAlerts = True
    End Sub
    Need your help to replicate the same for Trans detail tab as well..

    Trans Detail data starts from A95, and I need columns till R

    Thanks alot for your help.

    Regards,
    Raj
    Last edited by Excel Fox; 04-14-2013 at 08:09 PM. Reason: Code Tags Added

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Try this....

    Code:
    Sub DistributeRows()
    
        Dim wbNew As Workbook
        Dim wsData As Worksheet
        Dim wksTransDet As Worksheet
        Dim wsCrit As Worksheet
        Dim wsNew As Worksheet
        Dim rngCrit As Range
        Dim LastRow As Long
         
        Set wsData = Worksheets("LOAD DATA")
        Set wksTransDet = Worksheets("Trans Detail")
        Set wsCrit = Worksheets.Add
        LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
        wsData.Range("A1:A" & LastRow - 1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
         
        Set rngCrit = wsCrit.Range("A2")
        While rngCrit.Value <> ""
            Set wbNew = Workbooks.Add(xlWorksheet)
            wbNew.Sheets.Add
            wsData.Range("A1:AH" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wbNew.Sheets(1).Range("A1"), Unique:=True
            wksTransDet.Range("A95:R" & wksTransDet.Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wbNew.Sheets(2).Range("A1"), Unique:=True
            With wbNew
                .Sheets(1).Name = rngCrit
                .Sheets(2).Name = rngCrit & "-2"
                .SaveAs ThisWorkbook.Path & "\" & rngCrit & "-" & Format(Date, "dd mmm yy")
                .Close SaveChanges:=True
            End With
            rngCrit.EntireRow.Delete
            Set rngCrit = wsCrit.Range("A2")
        Wend
        Application.DisplayAlerts = False
        wsCrit.Delete
        Application.DisplayAlerts = True
        Set wbNew = Nothing
        Set wksTransDet = Nothing
        Set wsData = Nothing
        
    End Sub
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Junior Member
    Join Date
    Aug 2011
    Posts
    10
    Rep Power
    0
    Hi,

    Thanks alot for your Outstanding support and help with in short span of time.

    would like to thank you for all your efforts and knowledge sharing part.

    Thanks & Regards,
    Raj

Similar Threads

  1. Replies: 17
    Last Post: 05-22-2013, 11:58 PM
  2. Replies: 6
    Last Post: 05-20-2013, 10:06 PM
  3. Replies: 2
    Last Post: 09-24-2012, 09:20 PM
  4. Extract data using Advanced Filter
    By PcMax in forum Excel Help
    Replies: 4
    Last Post: 01-02-2012, 02:31 AM
  5. Split Closed Workbook into Multiple Workbooks Using ADO
    By ramakrishnan in forum Excel Help
    Replies: 4
    Last Post: 10-02-2011, 08:34 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •