Split workbook

[Cheryl]

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.

 

[Tom Ogilvy]

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.

 

[Ron de Bruin]

More information please