[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Split an worksheet into multiple files

Posted on 2013-11-08
6
Medium Priority
?
295 Views
Last Modified: 2013-11-08
Hi guys,

I have a worksheet with about 15000 records organized in a table as follows;

Field1   Fiel 2      Field3    Field4    Field5    Field6
Data     Name1  Data      data        data      data
data     Name1   data      data        data      data
Data     Name2 Data      data        data       data
data     Name2   data      data        data      data

Can anyone give the VBA code to split the worksheet in multiple excel files = Number of Names.
For each Name in the Field 2 I would like to have a file. The number of records is different from one name to another. So a name can have 33 records and another name 333 records.       The number of names is about 70.
Thank you very much,
0
Comment
Question by:marian68
  • 2
  • 2
  • 2
6 Comments
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 1200 total points
ID: 39633413
Sub split2sheets()
    Dim sws As Worksheet
    Dim tws As Worksheet
    Dim i As Long
    Dim rstrt As Long
    Dim rend As Long
    Set sws = ActiveSheet
    rstrt = 2
    For i = 3 To sws.Range("B" & Rows.Count).End(xlUp).Row + 1
        If sws.Cells(i, 2) <> sws.Cells(i - 1, 2) Then
            Set tws = Worksheets.Add
            tws.Name = sws.Cells(rstrt, 2)
            sws.Range("A1").EntireRow.Copy tws.Range("A1")
            sws.Range(sws.Cells(rstrt, 1), sws.Cells(i - 1, 1)).EntireRow.Copy tws.Range("A2")
            tws.Move
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs sws.Parent.Path & "\" & ActiveSheet.Name & ".xls"
            Application.DisplayAlerts = True
            ActiveWorkbook.Close
            rstrt = i
        End If
    Next i
End Sub
0
 
LVL 35

Assisted Solution

by:[ fanpages ]
[ fanpages ] earned 800 total points
ID: 39633415
Hi,

The code provided by ssaqibh in your earlier question, could be changed slightly thus:

Sub split2workbooks()
    
' See also: [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28288113.html#a39632141 ]

  Dim i                                                 As Long
  Dim lngApplication_SheetsInNewWorkbook                As Long
  Dim objWorkbook                                       As Workbook
  Dim rend                                              As Long
  Dim rstrt                                             As Long
  Dim sws                                               As Worksheet
  Dim tws                                               As Worksheet
  
  lngApplication_SheetsInNewWorkbook = Application.SheetsInNewWorkbook
  Application.SheetsInNewWorkbook = 1&
    
  Set sws = ActiveSheet
  
  rstrt = 2
  
  For i = 3 To sws.Range("B" & Rows.Count).End(xlUp).Row + 1
      
      If sws.Cells(i, 2) <> sws.Cells(i - 1, 2) Then
         Set objWorkbook = Workbooks.Add
         Set tws = objWorkbook.Worksheets(1&)
           
         tws.Name = Left$(sws.Cells(rstrt, 2), 31)
         sws.Range("A1").EntireRow.Copy tws.Range("A1")
         sws.Range(sws.Cells(rstrt, 1), sws.Cells(i - 1, 1)).EntireRow.Copy tws.Range("A2")
         
         rstrt = i
           
         Application.DisplayAlerts = False
           
         objWorkbook.Close SaveChanges:=True, _
                           Filename:="C:\" & tws.Name
                             
         Application.DisplayAlerts = True
      End If
      
  Next i
    
  Application.SheetsInNewWorkbook = lngApplication_SheetsInNewWorkbook

  Set objWorkbook = Nothing
  
End Sub

Open in new window



Please change this line to reference the required folder where the individual workbooks should be saved:

         objWorkbook.Close SaveChanges:=True, _
                           Filename:="C:\" & tws.Name

Presently they are saved in the root folder of drive C:

BFN,

fp.
Q-28289006.xls
0
 
LVL 35

Expert Comment

by:[ fanpages ]
ID: 39633417
^ Twenty four seconds! :)
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 39633460
Cost of perfection with the extra comments and instructions.
0
 

Author Closing Comment

by:marian68
ID: 39633668
The both solution are excellent. For me the difference in speed is not noticeable.
Anyway the solution of ssaqibh doesn't need a path and suits me better.
Thank you both and have a nice day
0
 

Author Comment

by:marian68
ID: 39633693
I don't know if there is a point to ask another question.
It is possible to improve this code so that the data in each created file is organized as a table?
Let me know please if the answer is no or yes to ask another question
Thank you
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question