Spliting excel data into multiple files based on number of rows with column headings

smiet

New Member
Joined
Jun 18, 2015
Messages
3
I don't have much VBA knowledge, so it's been a struggle for me. I have this list of person information with six columns, viz., Serial No., First Name, Last Name, Age, Email and Contact number with around 800+ rows. I want this list to split up into different excel workbooks (.xls) with 30 lines in a file without changing serial no. In the same VBA I want to change column widths so that it would fit into A4 size pages and most important thing is I don't want these file to be saved, that means I want them be opened after macro has finished running.

Can anyone please provide certain light or proper solution on this?
 

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,808
paste into VBE
run: SplitIntoWbs

Code:
  'split ws into separate workbooks
'---------------
Sub SplitIntoWbs()
'---------------
Const kMAX = 30
Dim wb As Workbook


Set wb = ActiveWorkbook


Range("A2").Select
While ActiveCell.Value <> ""
    Rows("1:" & kMAX).Select
    
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    PageSetup
    
    wb.Activate
    Rows("2:" & kMAX).Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
Wend
wb.Close False
Set wb = Nothing
End Sub
'---------------
Private Sub PageSetup()
'---------------
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Application.CutCopyMode = False


    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Range("A1").Select
End Sub
 

smiet

New Member
Joined
Jun 18, 2015
Messages
3
Thanks ranman256, it worked, kudos. But I want to give constant column width for all excels, for example., Serial No. as 10, First Name as 25, Last Name 20, etc.

Can you please reply again?
 

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,808
record a macro
set the col width on one
stop macro.
edit the macro
now you see syntax for the 1, so set all the others.
then just add this macro as the first line in SUB PAGESETUP.
INSTEAD OF THE LINE: AUTOFIT (remove the autofit line)
 
Last edited:

Forum statistics

Threads
1,082,548
Messages
5,366,227
Members
400,880
Latest member
dwb

Some videos you may like

This Week's Hot Topics

Top