Create Multiple XLS files from 1 "master" dbase ex


Active Member
Jun 10, 2003
I have 1 "master" sheet that contains all my Test Script records from a database dump - about 6,000 in all (MS-Query creates the sheet data - records are sorted by colA). I want to scroll through the master list of all the records and based on a col A value change (script name) create an Excel file (in the current directory using the script name from col A as the file name). It should contain all the records that were in the range of the script name.
Example, if my data dump consisted of 250 records, (25 unique script names in col A, and each script name covers 10 rows (10 steps in each script) then I want to end up with 25 ".xls" files in the "current" directory (each .xls file will only contain the 10 records for that particular script name - which is also the same name of the .xls file) - i hope i explained that clearly....

Example Psuedo code:
For I = 1 to numberOfRecords
if aI <> aI+1 then create new .xls file with the name value in COL aI
else next I

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
i've made a little progress... I've been able to use code to insert a blank row when my A1 (test script name) value changes - thus resulting in a "CurrentRegion" for each test script.

My question now is: - is there a way to loop through and create a seperate ".xls" file for each CurrentRegion in my "master" spreadsheet?
Upvote 0
i think i got it folks... here's the code i'm using - 1 MINOR problem.... i only want to save (as the new .xls file) the new sheet that i create. Each file i create gets saved with both sheets (via the "saveas") - When i do the "Sheets(2).SaveAs the entire workbook is saved as the new file - rather than just sheet-2. How do i save just the new sheet-2 only??

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim Rw As Long
    Dim c As Range
    Dim Wsh As Worksheet
    Dim sFilter As String
    Dim sPath As String
    'determine how many rows, initialise
    Rw = Range("A65536").End(xlUp).Row
    Set Wsh = Sheets(2)
    sPath = ActiveWorkbook.Path & "\"
    'grab a list of unique items for filtering - save it in col Z
    Range("A1:A" & Rw).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "Z1"), Unique:=True
    'set up an autofilter, run through list
    For Each c In Range("Z2:Z" & Range("Z65536").End(xlUp).Row)
        sFilter = c.Value
        Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=sFilter
        Wsh.Cells.ClearContents  ' clear out sheet 2 before geting data to save
        Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
      ' remove col Z from sheet2 (temp column for filter values)
      Sheets(2).SaveAs Filename:=sPath & sFilter & ".xls"  (<=== HOW DO I SAVE JUST THE NEW SHEET ONLY??)
    Next c
    MsgBox "XLS Done"
End Sub
Upvote 0
Try something like this.
Sub DistributeRows()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
    Set wsData = Worksheets("Master (2)") ' change sheet name accordingly
    Set wsCrit = Worksheets.Add
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
    wsData.Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    Set rngCrit = wsCrit.Range("A2")
    While rngCrit.Value <> ""
        Set wsNew = Worksheets.Add
        wsData.Range("A1:E" & LastRow).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
        wsNew.Name = rngCrit
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit
        wbNew.Close SaveChanges:=True
        Application.DisplayAlerts = False
        Set rngCrit = wsCrit.Range("A2")
    Application.DisplayAlerts = True
End Sub
Upvote 0

Forum statistics

Latest member

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
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 "".
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