Excel 2003 - from spreadsheet to separate excel files

[marisam]

I have a spreadsheet with 8000 records. It is sorted by the car type. There are 70 car types. I would like to create a separate excel file for each car type. Is there a script I can use to do that?
SPREADSHEET
APP CAR TYPE
01 ACURA
02 ACURA
03 TOYOTA
From the above spreadsheet I'd like to create 2 separate excel files: acura and toyota.
Thanks

 

[robcarr]

hi this nearly does what you require.

Sub FilterAndPrint()
Dim ItemList As Variant, i As Integer
    ThisWorkbook.Activate
    Application.ScreenUpdating = False
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    FindUniqueItems ItemList, "DataList"
    Range("DataList").AutoFilter
    For i = 1 To UBound(ItemList)
        Range("DataList").AutoFilter 1, ItemList(i)
        Application.StatusBar = "Printing report for " & ItemList(i)
        'ActiveSheet.PrintOut ' commented out for demonstration purposes
        ActiveSheet.PrintPreview ' comment out this line for proper use
    Next i
    Application.StatusBar = False
    ActiveSheet.ShowAllData
End Sub

this code filters each value in column 1 and then send the filtered data to the print preview, you just need to amend to copy to a worksheet, I have done exactly what you require before, but cannot find code anymore, however, this is where I started my coding from.

Hope this is of use, Rob.

 

[SkipVought]

marisam.

Where is the code I asked you to generate with your macro recorder and post here?

Skip,

_[red][/red]

 

[marisam]

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 3/7/2007 by Laura Riley
'

'
Selection.AutoFilter Field:=1, Criteria1:="acura"
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
Application.Goto Reference:="Macro3"
End Sub

 

[SkipVought]

Use Data/Aadvanced Filter - Copy to another location - UNIQUE VALUES to generate a unique list of CARS on Sheet1

dim r as range
'this assumes that your unique list of CARS is in column A on Sheet1
for each r in Sheets("Sheet1").range(Sheets("Sheet1").[A2], Sheets("Sheet1").[A2].end(xldown))
'this assumes that your table is in Sheet2, A1
    Sheets("Sheet2").[A1].AutoFilter Field:=1, Criteria1:="acura"
    Sheets("Sheet2").Range(Sheets("Sheet2").[A1], Sheets("Sheet2").[A1].SpecialCells(xlLastCell)).Copy
    Sheets.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
' you need to assign [b]somevariable[/b] like a date or a sequential number to make each workbook name unique
    somevariable = format(now, "yymmddhhnnss")
    ActiveWorkbook.SaveAs "somename" & somevariable & ".xls"
    Activeworkbook.close
next

Skip,

_[red][/red]