+ Reply to Thread
Results 1 to 2 of 2

Split workbook into multiple workbooks based on data

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    11-20-2011
    Location
    Chicago, IL
    MS-Off Ver
    Excel 2007, Excel 2003, Excel 2010
    Posts
    284

    Split workbook into multiple workbooks based on data

    I have the following code that will filter the data and then create a new file for every unique filtered record. The code works correctly in that it is fllitering and creating the new files. The issue is that it is not pasting the header as well. Also, if there is multiple records for a filter, it is only pasting to the first line of the new file and continuously overwriting the data. Theses are the only two issues that I am noticing with this file. I am wondering if there is code that I could add after wb.Sheets(1).Paste that would solve the issues with this code. Thanks

    Sub SplitWorkbook(Optional colLetter As String, Optional SavePath As String)
    If colLetter = "" Then colLetter = "D"
    Dim lastValue As String
    Dim hasHeader As Boolean
    Dim wb As Workbook
    Dim c As Range
    Dim currentRow As Long
    hasHeader = True 'Indicate true or false depending on if sheet  has header row.
    
    If SavePath = "" Then SavePath = ThisWorkbook.Path
    'Sort the workbook.
    ThisWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range(colLetter & ":" & colLetter), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ThisWorkbook.Worksheets(1).Sort
        .SetRange Cells
        If hasHeader Then ' Was a header indicated?
            .Header = xlYes
        Else
            .Header = xlNo
        End If
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For Each c In ThisWorkbook.Sheets(1).Range("D:D")
        If c.Value = "" Then Exit For
        If c.Row = 1 And hasHeader Then
        Else
            If lastValue <> c.Value Then
                If Not (wb Is Nothing) Then
                    wb.SaveAs SavePath & "\" & lastValue & ".xls"
                    wb.Close
                End If
                lastValue = c.Value
                currentRow = 1
                Set wb = Application.Workbooks.Add
            End If
            ThisWorkbook.Sheets(1).Rows(c.Row & ":" & c.Row).Copy
            wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Select
           wb.Sheets(1).Paste
    
        End If
    Next
    If Not (wb Is Nothing) Then
        wb.SaveAs SavePath & "\" & lastValue & ".xls"
        wb.Close
    End If
    End Sub

  2. #2
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Split workbook into multiple workbooks based on data

    Not really getting into what your macro is doing, but I can offer a pretty much ready for primetime macro that does this, 100s of people have used it successfully after only a couple minor tweaks.


    'SHEET1 TO MANY WORKBOOKS
    Here's a macro for parsing rows of data from one sheet to many workbooks based on one column, workbooks named for the same values in that column.My macro names the workbooks for values in the column PLUS today's date, you can take a stab at removing the date part...or leave it in, it's a good technique.
    Last edited by JBeaucaire; 12-27-2019 at 04:02 AM.
    _________________
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    If you've been given good help, use the icon below to give reputation feedback, it is appreciated.
    Always put your code between code tags. [CODE] your code here [/CODE]

    ?None of us is as good as all of us? - Ray Kroc
    ?Actually, I *am* a rocket scientist.? - JB (little ones count!)

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Macro to split workbook into multiple workbooks by client name
    By avalerion in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 08-22-2013, 05:36 AM
  2. Split Data Into Multiple Workbook Based On Column value with exisitng sheet
    By breadwinner in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 06-18-2013, 09:23 AM
  3. Split a workbook into multiple workbooks
    By stewfeed in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 04-30-2013, 07:15 AM
  4. How to split workbook into multiple workbooks based on date range
    By simoncurrier in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 02-28-2013, 06:50 AM
  5. Split .xlsm workbook into multiple xlxs. workbooks
    By thelenw in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 11-29-2011, 04:28 PM

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1