How do I save an autofilter selection as a new file?
 

I have a spreadsheet with autofilters separating different offices financial
information. I want to sent select autofilters to office managers, but do
not not want them to have access to other offices information.

How can I do this and still save the formatting, etc?

How do I save an autofilter selection as a new file?
 

Lacey,

Try the macro below. It will create separate files for each entry in your key column. Select a
single cell in your database, then run the macro.

If your offices' names are in column A, select a cell in column A and reply with a 1 when prompted.

HTH,
Bernie
MS Excel MVP

Sub ExportDatabaseToSeparateFiles()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name = myShtName Then
Exit Sub
Else
mySht.Move
ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
ActiveWorkbook.Close
End If
Next mySht
End Sub



"IrishLacey" wrote in message
...
I have a spreadsheet with autofilters separating different offices financial
information. I want to sent select autofilters to office managers, but do
not not want them to have access to other offices information.

How can I do this and still save the formatting, etc?