Split ws into separate ws then copy and insert

[struf]

I have a worksheet, which I split into separate workbooks. this I have a mcro for and it works well. I would like to add some code that after splitting, i can copy three worksheets from another different workbook ( these are not new sheets, they are different report), and copy them over to each of the workbooks created by the first macro.

I have tried nesting the second needed macro into the first, putting it into various locations, but can't seem to get it to work.

The inital macro (Public Sub Split_It) is from this board.
I have tried to label what i am trying to add:

Public Sub Split_It2()
Dim iWorksheet As Integer 'loop variable
Dim sFilename As String, sPath As String

sPath = GetFolder()
If Len(sPath) = 0 Then Exit Sub
sPath = sPath & "\"
On Error Resume Next

'loop through all worksheets
For iWorksheet = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(iWorksheet).Activate
'set the filename for the output file
sFilename = sPath & ActiveSheet.Name & ".xlsx"


'copy the active sheet into new workbook
ActiveSheet.Copy
ActiveWorkbook.SaveAs _
Filename:=sFilename, _
FileFormat:=51, _
Password:="", _
CreateBackup:=False
Windows("ABC.xlsx").Activate
Sheets(Array("Jan", "Feb", "Mar")).Select -- this line is mine
Sheets(Array("Jan", "Feb", "Mar")).Copy Before:=Workbooks( _ -- this line is mine
"*.xlsx").Sheets(3)[/B] ActiveWorkbook.Close -- this line is mine


Next iWorksheet
End Sub

thanks in advance.

Regards.

struf

 

[Comfy]

Your saving the workbook before adding the new sheets, try:

Public Sub Split_It2()
Dim iWorksheet As Integer 'loop variable
Dim sFilename As String, sPath As String

sPath = GetFolder()
If Len(sPath) = 0 Then Exit Sub
sPath = sPath & "\"
On Error Resume Next

'loop through all worksheets
For iWorksheet = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(iWorksheet).Activate
'set the filename for the output file
sFilename = sPath & ActiveSheet.Name & ".xlsx"


'copy the active sheet into new workbook
ActiveSheet.Copy
ActiveWorkbook.SaveAs _
Filename:=sFilename, _
FileFormat:=51, _
Password:="", _
CreateBackup:=False
Windows("ABC.xlsx").Activate
Sheets(Array("Jan", "Feb", "Mar")).Select -- this line is mine
Sheets(Array("Jan", "Feb", "Mar")).Copy Before:=Workbooks( _ -- this line is mine
"*.xlsx").Sheets(3)[/B] 
ActiveWorkbook.Save
ActiveWorkbook.Close -- this line is mine


Next iWorksheet
End Sub

 

[struf]

Thank you for correcting my syntax.
However My other problem is that the i think this line is incorrect as i end up creating new books, and it does not copy these three sheets into each new workbook that is created:

Sheets(Array("Jan", "Feb", "Mar")).Copy Before:=Workbooks( _ -- this line is mine
"*.xlsx").Sheets(3)


My VBA is weak. I can read and modifiy, but not really create. This section is from recording a marco adn trying to place it into another.

 

[Comfy]

Public Sub Split_It2()
Dim iWorksheet As Integer 'loop variable
Dim sFilename As String, sPath As String

sPath = GetFolder()
If Len(sPath) = 0 Then Exit Sub
sPath = sPath & "\"
On Error Resume Next

'loop through all worksheets
For iWorksheet = 1 To ActiveWorkbook.Worksheets.Count
Worksheets(iWorksheet).Activate
'set the filename for the output file
sFilename = ActiveSheet.Name & ".xlsx"


'copy the active sheet into new workbook
ActiveSheet.Copy
ActiveWorkbook.SaveAs _
Filename:=sPath & sFilename, _
FileFormat:=51, _
Password:="", _
CreateBackup:=False
Windows("ABC.xlsx").Activate
Sheets(Array("Jan", "Feb", "Mar")).Select -- this line is mine
Sheets(Array("Jan", "Feb", "Mar")).Copy Before:=Workbooks( _ -- this line is mine
"sFilename").Sheets(3)[/B] 
ActiveWorkbook.Save
ActiveWorkbook.Close -- this line is mine


Next iWorksheet
End Sub

In that case I've changed it so that filepath and file name remain seperate objects. So that when specifying which workbook to copy to you can use sFilename.

Sorry havn't had chance to test.... it's home time.

 

[Norie]

Try this, you might have to change the name of the workbook the 'extra' worksheets are coming from - I took a guess at "ABC.xlsx".

Option Explicit
 
Public Sub Split_It2()
Dim ws As Worksheet
Dim wbNew As Workbook
Dim iWorksheet As Integer    'loop variable
Dim sFilename As String, sPath As String
 
     sPath = GetFolder()

    If Len(sPath) = 0 Then Exit Sub

    sPath = sPath & "\"

    On Error Resume Next
 
    'loop through all worksheets

    For iWorksheet = 1 To ActiveWorkbook.Worksheets.Count
        Set ws = Worksheets(iWorksheet)

        'set the filename for the output file
        sFilename = sPath & ws.Name & ".xlsx"

        'copy the  sheet into new workbook
        ws.Copy
        
        Set wbNew = ActiveWorkbook
 
        wbNew.SaveAs Filename:=sFilename, FileFormat:=51
 
        Workbooks("ABC.xlsx").Sheets(Array("Jan", "Feb", "Mar")).Copy After:=wbNew.Worksheets(1)
        
        wbNew.Close True
 
    Next iWorksheet
 
End Sub

One other thing I changed was the destination of the 'extra' worksheets in the new workbook.

In the original code you appeared to be trying to insert copy them before the 3rd worksheet in the new workbook.

The new workbook should only have 1 worksheet.

 

[struf]

Almost there Norie.

I will try to explain in more detail

Original wb that is split is called Regions.xlsx
the first new wb created by the split is called CA.xlsx
From a second wb ( we're calling that ABC.xlsx) , i need to copy ws Jan, Feb and Mar to CA.XLSX, then have CA.XLSX closed, and go to the second new wb that had been created, CT.xlsx, and repeat the process.

Your macro is working for CA.xlsx, however then it seems to be spliting ABC.XLSX , and copying and inserting the sheets from ABC.XLSX back .

We are close. I apologize for the lack of detail on the first go around.

 

[Norie]

Well I was going to ask about the other workbook, specifically if it was the same workbook the code is in.

Sounds like it isn't.

You should be able to fix the problem by adding references for the all the workbooks involved.

By the way did you change the code at all?

I'll repost the code with the change I suggested a few others things that might help.

Option Explicit
 
 
Public Sub Split_It2()
Dim wbABC As Workbook
Dim wbNew As Workbook
Dim wbThis As Workbook
Dim ws As Worksheet
Dim sFilename As String, sPath As String
 
 
    Set wbThis = ThisWorkbook ' reference to workbook code is in, which I assume is the one you want to split as well
 
    Set wbABC = Workbooks("ABC.xlsx") ' reference to workbook where the 'extra' worksheets come from
 
    sPath = GetFolder()
 
    If Len(sPath) = 0 Then Exit Sub
 
    sPath = sPath & "\"
 
    On Error Resume Next
 
    'loop through all worksheets
    For Each ws In wbThis.Worksheets
 
        'set the filename for the output file
        sFilename = sPath & ws.Name & ".xlsx"
 
        'copy the  sheet into new workbook
        ws.Copy
 
        Set wbNew = ActiveWorkbook ' reference to newy created workbook
 
        wbNew.SaveAs Filename:=sFilename, FileFormat:=51
 
        wbABC.Sheets(Array("Jan", "Feb", "Mar")).Copy After:=wbNew.Worksheets(1)
 
        wbNew.Close True
 
    Next ws
 
End Sub

Give that a try and post back when it doesn't work properly.

 

[struf]

Excellent and perfect.

Thank you for your time. It is truely appreciated.