Break up main workbook into multiple workbooks

  • I am tyring to figure a way to automate the following process...... I have a spreadsheet with 2,000 rows of information. I'm trying to copy specific groups of rows from the main spreadsheet into individual workbooks. The rows on the main sheet can be sorted by similar id #s within each row.
    any help would be greatly appreciated..thank you

  • Sub Extract_AnalysisNewWB()
    'Macro written by Roy Cox
    'Variables used by the macro
    Dim FilterCriteria
    Dim CurrentFileName As String
    Dim NewFileName As String

    'Get the current file's name
    CurrentFileName = ActiveWorkbook.Name
    'Select the first 10 columns and first 100 rows
    '(note you can change this to meet your requirements)
    'Apply Autofilter
    'Get the filter's criteria from the user
    FilterCriteria = InputBox("Enter Analysis")
    'Filter the data based on the user's input
    'NOTE - this filter is on column A (field:=1), to change
    'to a different column you need to change the field number
    Selection.AutoFilter Field:=4, criteria1:=FilterCriteria
    'Select the visible cells (the filtered data)
    'Copy the cells
    'Open a new file
    Workbooks.Add Template:="Workbook"
    'Get this file's name
    NewFileName = ActiveWorkbook.Name
    'Make sure you are in cell A1
    'Paste the copied cells
    Range("D1") = FilterCriteria & ":" & "Analysis Report"
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.AutoFormat Format:=xlRangeAutoFormatClassic2, Number:=True, Font _
    :=True, Alignment:=True, Border:=True, Pattern:=True, Width:=True
    With Selection.Font
    .Name = "Arial"
    .Size = 14
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    End With
    Selection.Font.ColorIndex = 13
    Selection.Font.Bold = True
    'Clear the clipboard contents
    Application.CutCopyMode = False
    'Go back to the original file
    'Clear the autofilter
    Selection.AutoFilter Field:=1
    'Take the Autofilter off
    'Go to A1

    End Sub

    This is a macro that I use to extract data from a Purchase Ledger to a new workbook. I have left comments in to help.
    You should be able to adapt it to your purposes.
    Post back if you need more help

  • Roy,

    have you tried putting

    application.screenupdating = false

    at the beginning of your macro


    application.screenupdating = true

    at the end

    I do a similar print macro which filters a few thousand rows then prints the results, filters on a next set, then prints, blah blah blah..... it used to take an hour until I switched the screen updating off while it ran.... now it's down to about 10 minutes

    the results are the same, just you don't sit and wait for the screen to receive its information...


Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!