Sub CreateWorksheets()

Dim wkbkCurrent As Workbook
Dim wsData As Worksheet
Dim wsFilter As Worksheet
Dim ws As Worksheet
Dim cell As Range
Dim colManagers As New Collection
Dim vntManager As Variant
Dim lngNumRows As Long

Set wkbkCurrent = ActiveWorkbook
Set wsData = wkbkCurrent.Worksheets("MyData")
Set wsFilter = wkbkCurrent.Worksheets("MyFilter")

Application.StatusBar = "Creating workbooks. Please wait..."
Application.ScreenUpdating = False

'Count the number of rows
lngNumRows = wsData.Range("A" & Rows.Count).End(xlUp).Row

'Create a collection of managers from values in column A
On Error Resume Next
For Each cell In wsData.Range("A2:A" & lngNumRows)
colManagers.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0

'Delete 3 columns
wsData.Range("F:H").EntireColumn.Delete

'Filter on each manager, create workbook,
'save workbook and close workbook
For Each vntManager In colManagers

'Put the manager's name into the filter criteria range
wkbkCurrent.Worksheets("MyFilter").Range("A2").Val ue =
vntManager

Set ws = wkbkCurrent.Worksheets.Add

'Change the sheet name
ws.Name = vntManager

'Filter the data based on your criteria range
'and copy the filtered data to the new workbook
'Make sure your range refers to the new, smaller range
'now that you have deleted your columns
wsData.Range("A1:G10").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wsFilter.Range("A1:A2"), _
CopyToRange:=ws.Range("A1")

'Insert blank columns in new worksheet
ws.Range("F:H").EntireColumn.Insert

Next vntManager

'Insert 3 columns in original worksheet
wsData.Range("F:H").EntireColumn.Insert

LeaveSub:

Set colManagers = Nothing
Set cell = Nothing
Set wsData = Nothing
Set ws = Nothing
Set wsFilter = Nothing
Set wkbkCurrent = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

--
HTH,
Dianne

In ,
mikeb1 typed:
Thanks alot Dianne. Seems to work great. Yeah, there are three blank
columns which can be taken out and then re-added later. The only
criteria is each worksheet needs three blank colums inserted after the
"E" column. I can delete the three columns beforehand. Do you know
the code to do this, or could you put that mod. in my code for me?

Thanks a million - you saved me a great deal of hand labor.

-Mike


---
Message posted from http://www.ExcelForum.com/