Split workbook
Assume the managers name is in Cell B2 of each sheet
Option Explicit
Public Sub SpitWorkbook()
Dim W As Worksheet
Dim bk As Workbook
Dim sCheryl As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each W In Worksheets
sCheryl = W.Range("B2").Value
Set bk = Nothing
On Error Resume Next
Set bk = Workbooks(sCheryl)
On Error GoTo 0
If bk Is Nothing Then
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\" & sCheryl & ".xls"
Else
ActiveSheet.Copy After:=bk.Worksheets( _
bk.Worksheets.Count)
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
bk.Save
End If
Next W
For Each bk In Application.Workbooks
If bk.Name < ThisWorkbook.Name Then
bk.Close Savechanges:=False
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Code is untested, but should be work.
--
Regards,
Tom Ogilvy
"Cheryl" wrote in message
...
MS Office 2000, Windows 2000
Able to split the workbook so each sheet creates a new
workbook with the following macro.
Public Sub SpitWorkbook()
Dim W As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each W In Worksheets
ActiveSheet.Copy
Cells.Copy
Cells.PasteSpecial xlPasteValues
Cells(1).Select
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path
& "/" & W.Name
ActiveWorkbook.Close
Next W
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
However, as each sheet represents an employee I need the
employees that report to the same manager copied to the
same workbook.
|