Keep a pivot table after splitting sheets into workbooks

0

HI,

I used the attached macro to split info in columns into sheets and then save all sheets as independent excel files. 

I want to keep a common sheet (can be a pivot table sheet or glossary) saved in the independent excel files.

Kindly made modifications to the code.

Sub SplitData()
    Const NameCol = "N"
' name of column that needs to be split into sheets
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet
    Dim TrgSheet As Worksheet
    Dim SrcRow As Long
    Dim LastRow As Long
    Dim TrgRow As Long
    Dim Student As String
    Application.ScreenUpdating = False
    Set SrcSheet = ActiveSheet
    LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    For SrcRow = FirstRow To LastRow
        Student = SrcSheet.Cells(SrcRow, NameCol).Value
        Set TrgSheet = Nothing
        On Error Resume Next
        Set TrgSheet = Worksheets(Student)
        On Error GoTo 0
        If TrgSheet Is Nothing Then
            Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            TrgSheet.Name = Student
            SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
        End If
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
    Next SrcRow
    Application.ScreenUpdating = True
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = false
End Sub

[Edited: Added code from the file here.]

Answer
Discuss

Discussion

I don't see any code or sample file. Edit your question and try to upload/attach it again.
don (rep: 1322) Dec 12, '17 at 4:43 am
Hi Don,

added the excel file
gantis Dec 12, '17 at 9:43 pm
So, it looks like you will copy everything from Column N into a new worksheet and then save each worksheet into a new workbook; but, you also want a "main" common worksheet to be copied into each new workbook, is that correct?

(Also, I updated the post so the code was visible there instead of just in the Excel file.)
don (rep: 1322) Dec 13, '17 at 9:53 am
Add to Discussion

Answers

0

Here is what I think you are looking for...

You need to add these two lines of code:

Add to the top of the macro

Dim wsCommon As Worksheet
Set wsCommon = Sheets("Sheet1")

Add to the part of the macro where you copy worksheets to the new workbook

wsCommon.Copy Before:=ActiveWorkbook.Sheets(1)

Replace Sheet1 in the first piece of code with the name of the worksheet that you want to go into each new file.

This code simply sets a variable equal to the common worksheet that you want to have in each file and then it copies that sheet over to the new workbook.

Your final code could be like this:

Sub SplitData()
    Const NameCol = "N"
' name of column that needs to be split into sheets
    Const HeaderRow = 1
    Const FirstRow = 2
    Dim SrcSheet As Worksheet
    Dim TrgSheet As Worksheet
    Dim SrcRow As Long
    Dim LastRow As Long
    Dim TrgRow As Long
    Dim Student As String

    'Set a common sheet variable and set it equal to the common worksheet
    Dim wsCommon As Worksheet
    Set wsCommon = Sheets("Sheet1")

    Application.ScreenUpdating = False
    Set SrcSheet = ActiveSheet
    LastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    For SrcRow = FirstRow To LastRow
        Student = SrcSheet.Cells(SrcRow, NameCol).Value
        Set TrgSheet = Nothing
        On Error Resume Next
        Set TrgSheet = Worksheets(Student)
        On Error GoTo 0
        If TrgSheet Is Nothing Then
            Set TrgSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            TrgSheet.Name = Student
            SrcSheet.Rows(HeaderRow).Copy Destination:=TrgSheet.Rows(HeaderRow)
        End If
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
    Next SrcRow
    Application.ScreenUpdating = True
Dim xPath As String
xPath = Application.ActiveWorkbook.Path

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets

    xWs.Copy

    'Copy the common worksheet to the new file
    wsCommon.Copy Before:=ActiveWorkbook.Sheets(1)

    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False

Next
Application.DisplayAlerts = True
Application.ScreenUpdating = False

End Sub
Discuss

Discussion

Hi Don, thanks for the response. This code is showing an error
gantis Dec 27, '17 at 4:08 am
Dear Ron,

Please see attached the "test" sheet with random names and a Pivot table sheet. The code is also added in the file.

Need your help in modifying the code where each name parameters get saved as a seperate file along with the common pivot table.
gantis Dec 27, '17 at 4:15 am
Ok, so now, you need to edit the code to change the name of the new saved files or what exactly? I can't download the spreadsheet at the moment as Im on mobile.
don (rep: 1322) Dec 30, '17 at 2:12 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login