Looping and passing variables to a macro etc.

[IAM]

I have a macro that filters a list and then copies the filtered results to a
new page. I would love to have the macro keep running based on a specific
variable passed directly from a list of values on a sheet in the workbook.

Here is the basic macro I have now:
______++++++++++++++++______________
Application.Goto Reference:="SelectHeader"
ActiveSheet.Range("$A$5:$CW$355").AutoFilter Field:=77, Criteria1:="0350"
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit
______++++++++++++++++______________

I want to do a few things.

1. the criteria for the sort: I want to pass this as a variable from a cell
on a worksheet.

2. I want to loop this macro until it goes through all of the values in a
range for the Criteria1 until it finds and empty cell. e.g. I have 25
territories that need their own workbook so I want the macro to go through an
create workbooks for all 25 territories and then stop.

3. I want to name the new workbooks using the same variable passed in for
the sort criteria + some standard text. e.g. Territory_0350.xls

Thanks,

Iam

 

[Bernie Deitrick]

First you ask for separate worksheets, then separate workbooks....so....

The code below is written on the assumption that you have no completely blank rows or columns in
your data set, set to export based on column BY....

HTH,
Bernie
MS Excel MVP


Sub ExportFilesFromDatabase()
'Based on the value in the 77th column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myCol As Integer
Dim myShtName As String

myShtName = ActiveSheet.Name

'ActiveSheet.Range("$A$5:$CW$355").AutoFilter Field:=77
'Export based on values in column BY ( the 77th column of A:CW)

myCol = 77

Set myArea = ActiveSheet.Range("$A$5:$CW$" & Cells(Rows.Count, 1).End(xlUp).Row)
Set myArea = myArea(2, myCol).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
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=myCol, 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