slicing and dicing worksheets into spearate excel workbooks

Hi,

I've three workbooks a.xls., b.xls, c.xls, each contains 50-60 sheets,

the name of each sheet corresponds to a salesperson

I need to group each salesperson into a separate workbook in vba

all salespeople are in  workbook a.xls and b.xls but only a few are in c.xls

so for example of

in a.xls I've got
Salesperson1
Salesperson2
Salesperson3

in b.xls I've got
Salesperson1
Salesperson2
Salesperson3
 
in c.xls I've got
Salesperson1


What  I need to create is

a workbook call salesperson1 which has three sheets
a.xls.Salesperson1
b.xls.Salesperson1
c.xls.Salesperson1

a workbook call salesperson2 which has three sheets
a.xls.Salesperson2
b.xls.Salesperson2


a workbook call salesperson3 which has three sheets
a.xls.Salesperson3
b.xls.Salesperson3

Any help would be much appreciated.
Regards,
linnanda


LINNANDAAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Robberbaron (robr)Commented:
so will you end up with 50 workbooks with 3 sheets(a,b,c) or one workbook with 50 sheets
0
Robberbaron (robr)Commented:
try this in each of your master workbooks. ie A, B, C

run the CopySheets macro for each.

If this is the correct format, we can try to automate selecting master and running macro.
Sub CopySheets()
 
'macro by RobberBaron.  EE.  2/Feb/2008
 
    Dim oSht As Worksheet
    Dim oWb As Workbook, oWrkDest As Workbook
    Dim sShtName As String, oWbName As String
    
    oWbName = ActiveWorkbook.Name
    
    For Each oSht In ActiveWorkbook.Sheets
        'get workbook name
        sShtName = oSht.Name
        'see if destination workbook open
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sShtName & ".xls") Then
                'found it
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open FileName:=sShtName & ".xls", Editable:=True
            If Err.Number = 1004 Then
                'not found so create
                On Error GoTo 0
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = ActiveWorkbook
                oWb.SaveAs FileName:=sShtName & ".xls"
            End If
            
 
        End If
        'copy before sheet 1 in desination
        oSht.Copy Before:=oWb.Sheets(1)
    Next oSht
End Sub

Open in new window

0
Robberbaron (robr)Commented:
update to fix naming of output sheets
Sub CopySheets()
'
' Macro by RobberBaron   EE  2/Feb/2008
'v 2
 
'
    Dim oSht As Worksheet, i As Integer
    Dim oWb As Workbook, oWrkDest As Workbook
    Dim sShtName As String, sWbName As String
    
    sWbName = ActiveWorkbook.Name      'this gives name incl .XLS
    i = InStr(1, sWbName, ".")
    sWbName = Left(sWbName, i - 1)
    
    For Each oSht In ActiveWorkbook.Sheets
        'get workbook name
        sShtName = oSht.Name
        'see if destination workbook open
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sShtName & ".xls") Then
                'found it
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open FileName:=sShtName & ".xls", Editable:=True
            If Err.Number = 1004 Then
                'not found so create
                On Error GoTo 0
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = ActiveWorkbook
                oWb.SaveAs FileName:=sShtName & ".xls"
            End If
            
 
        End If
        'need to temp name sheet as the workbook name before copy
        oSht.Name = sWbName       'set name for destination
        oSht.Copy Before:=oWb.Sheets(1)     'copy sheet to destination
        oSht.Name = sShtName   'set back to correct name
    Next oSht
End Sub

Open in new window

0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

LINNANDAAuthor Commented:
Hi robberbaron,

The name of the files are outputing correctly but only a sheet from one of the workbooks is populating the new workbooks.  

The macro that is running the code is being called from a separate workbook with three sheets so what I getting is

b.xls/ Sheet1/sheet2/sheet3

in each workbook, I think it would be better if I called the workbook explicitly?
0
Robberbaron (robr)Commented:
yes.

The way i wrote the code, it is attached to each & every source workbook and run for each. ie 3 times.

to run from a master macro is quite easy but a few changes need to be made.

roughly

set wbAction=workbooks("WB1.xls")
CopySheet (wbAction)


and in CopySheet, change all ActiveWorkbook to be wbAction.

i'll be able to give better code tonight.

0
LINNANDAAuthor Commented:
Hi

I tired this but am getting the wrong number of arguements on   CopySheets (wbAction)

       
Sub CopySheets()

'
' Macro by RobberBaron   EE  2/Feb/2008
'v 2
 
'
    Dim oSht As Worksheet, i As Integer
    Dim oWb As Workbook, oWrkDest As Workbook
    Dim sShtName As String, sWbName As String
   
    sWbName = wbAction.Name      'this gives name incl .XLS
    i = InStr(1, sWbName, ".")
    sWbName = Left(sWbName, i - 1)
   
    For Each oSht In wbAction.Sheets
        'get workbook name
        sShtName = oSht.Name
        'see if destination workbook open
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sShtName & ".xls") Then
                'found it
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open Filename:=sShtName & ".xls", Editable:=True
            If Err.Number = 1004 Then
                'not found so create
                On Error GoTo 0
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = wbAction
                oWb.SaveAs Filename:=sShtName & ".xls"
            End If
           
 
        End If
        'need to temp name sheet as the workbook name before copy
        oSht.Name = sWbName       'set name for destination
        oSht.Copy Before:=oWb.Sheets(1)     'copy sheet to destination
        oSht.Name = sShtName   'set back to correct name
    Next oSht

End Sub


Sub test()

  Set wbAction = Workbooks("C:\a.xls")
    CopySheets (wbAction)

End Sub
0
Robberbaron (robr)Commented:
1/ change to  
Sub CopySheets( wbAction )


2/ also change to...
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = ActiveWorkBook     'add returns new as activeworkbook
                oWb.SaveAs Filename:=sShtName & ".xls"

0
LINNANDAAuthor Commented:
Hi robberbaron,

Applied these changes, ran the test macro and got

Run-time error '9'

Subscript out of range

on

Set wbAction = Workbooks("C:\a.xls")

I also need to add b.xls and c.xls into this script.
0
Robberbaron (robr)Commented:
update.

put this code in your master workbook.

it opens each source workbook and copies sheets to destination workbooks
Sub Master()
    Dim oWb As Workbook
    
    ChDir ActiveWorkbook.Path
    
    Set oWb = GetWorkBook("WB_A")
        CopySheets oWb
        oWb.Close False   'close without saving
        
        
    Set oWb = GetWorkBook("WB_B")
        CopySheets oWb
        oWb.Close False   'close without saving
 
    Set oWb = GetWorkBook("WB_C")
        CopySheets oWb
        oWb.Close False   'close without saving
    
End Sub
 
Function GetWorkBook(sWbname As String) As Workbook
    Dim oWb As Workbook
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sWbname & ".xls") Then
                'found it
                Set GetWorkBook = oWb
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open FileName:=sWbname & ".xls", Editable:=True
            If Err = 0 Then
                Set GetWorkBook = ActiveWorkbook
            End If
        End If
End Function
 
Sub CopySheets(wbActive As Workbook)
'
' Macro RobberBaron   EE  2/Feb/2008
'v 2
 
'
    Dim oSht As Worksheet, i As Integer
    Dim oWb As Workbook, oWrkDest As Workbook
    Dim sShtName As String, sWbname As String
    
    sWbname = wbActive.Name      'this gives name incl .XLS
    i = InStr(1, sWbname, ".")
    sWbname = Left(sWbname, i - 1)
    
    For Each oSht In wbActive.Sheets
        'get workbook name
        sShtName = oSht.Name
        'see if destination workbook open
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sShtName & ".xls") Then
                'found it
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open FileName:=sShtName & ".xls", Editable:=True
            If Err.Number = 1004 Then
                'not found so create
                On Error GoTo 0
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = ActiveWorkbook
                oWb.SaveAs FileName:=sShtName & ".xls"
            End If
            
 
        End If
        'need to temp name sheet as the workbook name before copy
        oSht.Name = sWbname        'set name for destination
        oSht.Copy Before:=oWb.Sheets(1)   'copy sheet to destination
 
        oSht.Name = sShtName  'set back to correct name
    Next oSht
End Sub

Open in new window

0
LINNANDAAuthor Commented:
Hi,
 

I ran this macro from Sub Master()

and got Run-time error '91'

Object variable or With block variable not sent

when I hit the debug button it hightlighted

sWbname = wbActive.Name      'this gives name incl .XLS

0
Robberbaron (robr)Commented:
the only macro you should run is Master()

it's not opening the desired workbook. ie named WB_A.xls

some error check attached. Replace master() code
Sub Master()
    Dim oWb As Workbook, sTmp
    
    ChDir ActiveWorkbook.Path
    
    sTmp = "WB_A"
    Set oWb = GetWorkBook(sTmp)
    If oWb Is Nothing Then
        MsgBox "Could not open " & ActiveWorkbook.Path & "\" & sTmp, vbCritical
        Exit Sub
    End If
        
        CopySheets oWb
        oWb.Close False   'close without saving
        
        
    sTmp = "WB_B"
    Set oWb = GetWorkBook(sTmp)
    If oWb Is Nothing Then
        MsgBox "Could not open " & ActiveWorkbook.Path & "\" & sTmp, vbCritical
        Exit Sub
    End If
        CopySheets oWb
        oWb.Close False   'close without saving
    
End Sub

Open in new window

0
LINNANDAAuthor Commented:
Hi,

Ive the three workbooks open and am getting a  Compile error :
ByRef argument type mismatch

when I run the Master macro

on

 Set oWb = GetWorkBook(sTmp)
0
Robberbaron (robr)Commented:
works ok for me on XL97.

try changing dim to
    Dim oWb As Workbook, sTmp as string
0
LINNANDAAuthor Commented:
Thanks robberbaron, that worked for me on excel 2000 the only thing is that I now have 60 sheets open which I need to close and save  to C:\Reports


i 've added  oWb.Close to Sub CopySheets(wbActive As Workbook)

but doesn't seem to work



Sub CopySheets(wbActive As Workbook)
'
' Macro RobberBaron   EE  2/Feb/2008
'v 2
 
'
    Dim oSht As Worksheet, i As Integer
    Dim oWb As Workbook, oWrkDest As Workbook
    Dim sShtName As String, sWbname As String
   
    sWbname = wbActive.Name      'this gives name incl .XLS
    i = InStr(1, sWbname, ".")
    sWbname = Left(sWbname, i - 1)
   
    For Each oSht In wbActive.Sheets
        'get workbook name
        sShtName = oSht.Name
        'see if destination workbook open
        For Each oWb In Application.Workbooks
            If UCase(oWb.Name) = UCase(sShtName & ".xls") Then
                'found it
                Exit For
            End If
        Next oWb
        If oWb Is Nothing Then
            'need to open
            On Error Resume Next
            Application.Workbooks.Open Filename:=sShtName & ".xls", Editable:=True
            If Err.Number = 1004 Then
                'not found so create
                On Error GoTo 0
                Application.Workbooks.Add      'should return wb but doesnt in XL97
                Set oWb = ActiveWorkbook
                oWb.SaveAs Filename:=sShtName & ".xls"
               
                 oWb.Close
            End If
           
 
        End If
        'need to temp name sheet as the workbook name before copy
        oSht.Name = sWbname        'set name for destination
        oSht.Copy Before:=oWb.Sheets(1)   'copy sheet to destination
 
        oSht.Name = sShtName  'set back to correct name
    Next oSht
End Sub
0
Robberbaron (robr)Commented:
i didnt close them as it makes it quicker to save the second and third sheets.

They are saved when first created.


at end of master()

   
    'close all except master
    For Each oWb In Application.Workbooks
        If UCase(oWb.Name) <> "MASTER.XLS" Then
            oWb.Close True
        End If
    Next oWb
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LINNANDAAuthor Commented:
Hi robberbaron,

I added the code to the end of master (0 but all the excel spreadhseets which have been created are still open,

Sub Master()
    Dim oWb As Workbook, sTmp As String
   
    ChDir ActiveWorkbook.Path
   
    sTmp = "WB_A"
    Set oWb = GetWorkBook(sTmp)
    If oWb Is Nothing Then
        MsgBox "Could not open " & ActiveWorkbook.Path & "\" & sTmp, vbCritical
        Exit Sub
    End If
       
        CopySheets oWb
        oWb.Close False   'close without saving
       
       
       
       
       sTmp = "WB_B"
    Set oWb = GetWorkBook(sTmp)
    If oWb Is Nothing Then
        MsgBox "Could not open " & ActiveWorkbook.Path & "\" & sTmp, vbCritical
        Exit Sub
    End If
       
        CopySheets oWb
        oWb.Close False   'close without saving
       
       
         sTmp = "WB_C"
    Set oWb = GetWorkBook(sTmp)
    If oWb Is Nothing Then
        MsgBox "Could not open " & ActiveWorkbook.Path & "\" & sTmp, vbCritical
        Exit Sub
    End If
       
        CopySheets oWb
       oWb.Close False  'close without saving
       
       
         For Each oWb In Application.Workbooks
        If UCase(oWb.Name) <> "MASTER.XLS" Then
            oWb.Close True
        End If
    Next oWb
       

   
End Sub
0
Robberbaron (robr)Commented:
it works for my test.

you will have to step through the macro to find why it doesnt get to the close loop
0
LINNANDAAuthor Commented:
Thanks robberbaron got it sorted
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.