[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

Split an worksheet into multiple files

Posted on 2013-11-08
6
Medium Priority
?
293 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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

Ask an Anonymous Question!

Don't feel intimidated by what you don't know. Ask your question anonymously. It's easy! Learn more and upgrade.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

649 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