Macro To Split a 4 Page workbook into Seperate workbooks

E

Emilietx

New Member
Joined
May 16, 2011
Messages
2
Hey all...
I have the following code that Splits a 1 page workbook into seperate workbooks based on location but I need to split a similar 4 page workbook (reading,math,science,social studies) into seperate workbooks based on location. (each page has each location.

The code loops through each page saving over the previous workbook ending up with 1 workbook per location with which ever subject is last.

I need to modify this code to work on all four sheets at once so I end up with 1 workbook for each location with 4 sheets in it.

All help is VERY appreciated!!
Thanks again,
Emilie
Code: 
Sub divide()
    'declare variables
    Dim campus As String
    Dim campusBegin As Double
    Dim campusEnd As Double
    Dim path As String
    Dim sheetName As String
    Dim bookName As String
    Dim newBookName As String
    Dim header As Integer
    Dim cRow As String
    Dim border As Integer
    Dim rBound As String
    Dim count As Long
    Dim back As Long
    Dim icolor As Integer
    back = 0
    count = 0
        
    header = InputBox("Please enter the number header rows: ", "User Input Needed")
    campusBegin = header + 1
    campusEnd = campusBegin
    
    cRow = InputBox("Please enter the letter of the campus number column:")
    rBound = InputBox("Please enter the letter of the last column to the right:")
    newBookName = InputBox("Please enter 'Save As' file name:", "Save File Name")
    newBookName = newBookName & " "
        
    'initialize variables
    'path = "C:\Documents and Settings\Administrator\Desktop\By Loc"
    path = ActiveWorkbook.path
    path = path & "\By Loc"
    MkDir (path)
    SetAttr path, vbNormal
    sheetName = ActiveSheet.Name
    bookName = ActiveWorkbook.Name
    
    'campus range - data rows
    Do Until Range(cRow & campusEnd).Value = Empty
        campus = Range(cRow & campusBegin).Value
        
        'select campus data
        Do Until Range(cRow & campusEnd).Value <> campus
            campusEnd = campusEnd + 1
            count = count + 1
        Loop
    
        campusEnd = campusEnd - 1
    
        'header row
        Range("A1:" & rBound & header).Copy
        Workbooks.Add
        Columns("A:A").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("A:A").ColumnWidth
        Columns("B:B").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("B:B").ColumnWidth
        Columns("C:C").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("C:C").ColumnWidth
        Columns("D:D").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("D:D").ColumnWidth
        Columns("E:E").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("E:E").ColumnWidth
        Columns("F:F").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("F:F").ColumnWidth
        Columns("G:G").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("G:G").ColumnWidth
        Columns("H:H").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("H:H").ColumnWidth
        Columns("I:I").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("I:I").ColumnWidth
        Columns("J:J").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("J:J").ColumnWidth
        Columns("K:K").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("K:K").ColumnWidth
        Columns("L:L").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("L:L").ColumnWidth
        Columns("M:M").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("M:M").ColumnWidth
        Columns("N:N").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("N:N").ColumnWidth
        Columns("O:O").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("O:O").ColumnWidth
        Columns("P:P").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("P:P").ColumnWidth
        Columns("Q:Q").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("Q:Q").ColumnWidth
        Columns("R:R").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("R:R").ColumnWidth
        Columns("S:S").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("S:S").ColumnWidth
        Columns("T:T").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("T:T").ColumnWidth
        Columns("U:U").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("U:U").ColumnWidth
        Columns("V:V").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("V:V").ColumnWidth
        Columns("W:W").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("W:W").ColumnWidth
        Columns("X:X").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("X:X").ColumnWidth
        Columns("Y:Y").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("Y:Y").ColumnWidth
        Columns("Z:Z").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("Z:Z").ColumnWidth
        Columns("AA:AA").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AA:AA").ColumnWidth
        Columns("AB:AB").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AB:AB").ColumnWidth
        Columns("AC:AC").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AC:AC").ColumnWidth
        Columns("AD:AD").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AD:AD").ColumnWidth
        Columns("AE:AE").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AE:AE").ColumnWidth
        Columns("AF:AF").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AF:AF").ColumnWidth
        Columns("AG:AG").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AG:AG").ColumnWidth
        Columns("AH:AH").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AH:AH").ColumnWidth
        Columns("AI:AI").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AI:AI").ColumnWidth
        Columns("AJ:AJ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AJ:AJ").ColumnWidth
        Columns("AK:AK").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AK:AK").ColumnWidth
        Columns("AL:AL").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AL:AL").ColumnWidth
        Columns("AM:AM").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AM:AM").ColumnWidth
        Columns("AN:AN").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AN:AN").ColumnWidth
        Columns("AO:AO").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AO:AO").ColumnWidth
        Columns("AP:AP").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AP:AP").ColumnWidth
        Columns("AQ:AQ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AQ:AQ").ColumnWidth
        Columns("AR:AR").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AR:AR").ColumnWidth
        Columns("AS:AS").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AS:AS").ColumnWidth
        Columns("AT:AT").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AT:AT").ColumnWidth
        Columns("AU:AU").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AU:AU").ColumnWidth
        Columns("AV:AV").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AV:AV").ColumnWidth
        Columns("AW:AW").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AW:AW").ColumnWidth
        Columns("AX:AX").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AX:AX").ColumnWidth
        Columns("AY:AY").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AY:AY").ColumnWidth
        Columns("AZ:AZ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("AZ:AZ").ColumnWidth
        Columns("BA:BA").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BA:BA").ColumnWidth
        Columns("BB:BB").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BB:BB").ColumnWidth
        Columns("BC:BC").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BC:BC").ColumnWidth
        Columns("BD:BD").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BD:BD").ColumnWidth
        Columns("BE:BE").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BE:BE").ColumnWidth
        Columns("BF:BF").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BF:BF").ColumnWidth
        Columns("BG:BG").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BG:BG").ColumnWidth
        Columns("BH:BH").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BH:BH").ColumnWidth
        Columns("BI:BI").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BI:BI").ColumnWidth
        Columns("BJ:BJ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BJ:BJ").ColumnWidth
        Columns("BK:BK").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BK:BK").ColumnWidth
        Columns("BL:BL").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BL:BL").ColumnWidth
        Columns("BM:BM").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BM:BM").ColumnWidth
        Columns("BN:BN").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BN:BN").ColumnWidth
        Columns("BO:BO").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BO:BO").ColumnWidth
        Columns("BP:BP").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BP:BP").ColumnWidth
        Columns("BQ:BQ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BQ:BQ").ColumnWidth
        Columns("BR:BR").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BR:BR").ColumnWidth
        Columns("BS:BS").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BS:BS").ColumnWidth
        Columns("BT:BT").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BT:BT").ColumnWidth
        Columns("BU:BU").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BU:BU").ColumnWidth
        Columns("BV:BV").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BV:BV").ColumnWidth
        Columns("BW:BW").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BW:BW").ColumnWidth
        Columns("BX:BX").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BX:BX").ColumnWidth
        Columns("BY:BY").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BY:BY").ColumnWidth
        Columns("BZ:BZ").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("BZ:BZ").ColumnWidth
        Columns("CA:CA").ColumnWidth = Workbooks(bookName).Sheets(sheetName).Columns("CA:CA").ColumnWidth
        ActiveSheet.Paste
        Range("A" & header + 1).Select
        ActiveSheet.Name = "Loc " & campus
        ActiveWorkbook.SaveAs path & "\" & newBookName & campus
        Workbooks(bookName).Activate
        Sheets(sheetName).Select
        
        'data rows
        Range("A" & campusBegin & ":" & rBound & campusEnd).Select
        Selection.Copy
        Workbooks(newBookName & campus & ".xlsx").Activate
        Sheets("Loc " & campus).Select
        ActiveSheet.Paste
        
        'format
        Cells.Select
        Cells.EntireColumn.AutoFit
        Columns("H:H").Select
        Selection.ColumnWidth = 10
        Columns("I:I").Select
        Selection.ColumnWidth = 10
        Columns("M:M").Select
        Selection.ColumnWidth = 8
        Columns("N:N").Select
        Selection.ColumnWidth = 8
        Columns("O:O").Select
        Selection.ColumnWidth = 8
        Columns("P:P").Select
        Selection.ColumnWidth = 8
        Columns("U:U").Select
        Selection.ColumnWidth = 23
        Columns("AA:AA").Select
        Selection.ColumnWidth = 23
        Columns("AG:AG").Select
        Selection.ColumnWidth = 23
        Columns("AM:AM").Select
        Selection.ColumnWidth = 23
        Columns("AS:AS").Select
        Selection.ColumnWidth = 23
        Columns("AY:AY").Select
        Selection.ColumnWidth = 23
        Columns("BE:BE").Select
        Selection.ColumnWidth = 23
        Columns("BK:BK").Select
        Selection.ColumnWidth = 23
        Columns("BQ:BQ").Select
        Selection.ColumnWidth = 23
        Columns("BW:BW").Select
        Selection.ColumnWidth = 23
               
        
        
        
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = header
        End With
        ActiveWindow.FreezePanes = True
        
'        ActiveWindow.Zoom = 85
        
        Range("A1:" & rBound & "1").Select
        Selection.AutoFilter
'        ActiveSheet.Protect Password:="DataDriven", DrawingObjects:=True, Contents:=True, Scenarios:=True _
'            , AllowFiltering:=True
'        ActiveSheet.EnableSelection = xlNoSelection
        
'       Insert formatting code here
With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .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
'       -------------------------------------------------
    
        Range("A1").Select
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Sheets(sheetName).Select
        campusBegin = campusEnd + 1
        campusEnd = campusBegin
        back = back + count
        count = 0
    Loop
    
    'deselect the selection and display confirmation
    Sheets(sheetName).Range("A1").Select
    MsgBox "Operation Successful!"
    
End Sub
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
By the way it doesn't HAVE to be this macro, I just have one workbook with two sheets with similar data. I need to split it using the same column on both sheets.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Very minor change in code had a dramatic impact on the speed. Why?
Replies
2
Views
806
deZine
D
G
  • Question Question
Move macros to a seperate workbook
Replies
0
Views
450
godcsu
G
S
  • Solved
Optimizing Macro
Replies
8
Views
2K
sax2play
S
J
  • Question Question
Macro to Search for Comments in Closed Workbooks
Replies
0
Views
594
jkouvel
J
C
  • Solved
How to Optimize Group of Macros
Replies
9
Views
878
johnnyL
J

Forum statistics

Threads
1,224,508
Messages
6,179,188
Members
452,893
Latest member
denay

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top