none
Saving several worksheets as separate workbooks in a new directory

    Question

  • I have searched many different forums and am unable to find what I am looking for so hopefully someone will be able to help me out.  I've found pieces and parts but nothing that seems to do what I want it to.

    If there's an easier way to do this I'm all ears.  Here's my situation

    I am using Excel 2010.  There is one tab (labeled "Main") where I input all of the assumptions/main data for the month.

    I also have 20+ other tabs labeled as manager names.  Each manager has a pair of tabs.  One that is more of a form that they use to input info (labeled Manager1, Manager2, etc) and one that pulls the data input into the form (labled Manager1_Data, Manager2_Data, etc) and stores in table format.

    I am trying to put codes together for two command buttons:

    CommandButton1

    1. Create a new folder in a directory.  The name of this created directory will be equal to A1 on the "Main" tab
    2. Save each manager tab pair (Manager1, Manager1_Data) as separate workbooks within that created directory with the filenames equal to cell A1 on their respective tab.  For example in Smith's file he'd have two tabs a "Smith" and "Smith_Data".  The "Smith" tab would be values only.  the "Smith_Data" tab would maintain it's links to the "Smith" tab. Also, hide the Data tab.

    1. CommandButton2:  Lastly I would like a separate code that would run after managers have updated all of their information.  This code would go to each of the manager's files within the created directory, retrieve the information from their "xx_Data" tabs and paste them (into the next available row) on a tab called "All_Data" in a static (doesn't move locations, is reused every month) file called "Database.xlsm"

    Any assistance someone could provide would be greatly appreciated

    Wednesday, December 12, 2012 7:00 PM

Answers

  • Sorry, Bernie, I guess I did something wrong, b/c I couldn't get that to work.  Here is an idea that you may be able to run with:

    Sub CreateWorkbooks()
    'Creates an individual workbook for each worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
    Dim strSavePath As String

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False 'Don't show any screen movement

    strSavePath = "C:\Users\Excel\Desktop\Excel_Books\" 'Change this to suit your needs

    Set wbSource = ActiveWorkbook

    For Each sht In wbSource.Sheets
    sht.Copy
    Set wbDest = ActiveWorkbook
    wbDest.SaveAs strSavePath & sht.Name
    wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next

    Application.ScreenUpdating = True

    Exit Sub

    ErrorHandler: 'Just in case something hideous happens
    MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
    End Sub


    Ryan Shuell

    Thursday, December 13, 2012 1:35 AM

All replies

  • Commandbutton1:

    Private Sub CommandButton1_Click()

        Dim myS As Worksheet
        Dim strPath As String
        Dim strName As String
       
        strPath = ThisWorkbook.Path
        On Error Resume Next
        ChDir strPath
        MkDir strPath & "\" & Worksheets("Main").Range("A1").Value    

        strPath = strPath & "\" & Worksheets("Main").Range("A1").Value

        For Each myS In Worksheets
            If myS.Name Like "*_Data" Then

                Sheets(Array(myS.Name, Replace(myS.Name, "_Data", ""))).Copy
                ActiveWorkbook.Worksheets(myS.Name).Visible = False
                strName = strPath & "\" & Worksheets(Replace(myS.Name, "_Data", "")).Range("A1").Value & ".xlsx"
                 ActiveWorkbook.SaveAs strName
                ActiveWorkbook.Close False
            End If
        Next myS
    End Sub

    Second one (You did not explain how the folder is indicated, so I assumed that the Database.xlsm file also has a "Main" sheet with the folder name in cell A1) Set a reference in your project to MS Scripting Runtime....

    Private Sub CommandButton2_Click()
        Dim FSO As Scripting.FileSystemObject
        Dim SourceFolder As Scripting.Folder
        Dim FileItem As Scripting.File
        Dim wkbkW As Workbook
        Dim myS As Worksheet
        Dim strPath As String

        strPath = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Main").Range("A1").Value

        Set FSO = New Scripting.FileSystemObject
        Set SourceFolder = FSO.GetFolder(strPath)

        For Each FileItem In SourceFolder.Files
            If FileItem.Type = "Microsoft Excel Worksheet" Then
                Set wkbkW = Workbooks.Open(strPath & "\" & FileItem.Name)
                For Each myS In wkbkW.Worksheets
                    If myS.Name Like "*_Data" Then
                        myS.Range("A1").CurrentRegion.Copy _
                                ThisWorkbook.Worksheets("All_Data").Cells(Rows.Count, 1).End(xlUp)(2)
                        GoTo FoundData:
                    End If
                Next myS
    FoundData:
                wkbkW.Close False
            End If
        Next FileItem

    End Sub



    Wednesday, December 12, 2012 8:05 PM
  • Sorry, Bernie, I guess I did something wrong, b/c I couldn't get that to work.  Here is an idea that you may be able to run with:

    Sub CreateWorkbooks()
    'Creates an individual workbook for each worksheet in the active workbook.
    Dim wbDest As Workbook
    Dim wbSource As Workbook
    Dim sht As Object 'Could be chart, worksheet, Excel 4.0 macro,etc.
    Dim strSavePath As String

    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False 'Don't show any screen movement

    strSavePath = "C:\Users\Excel\Desktop\Excel_Books\" 'Change this to suit your needs

    Set wbSource = ActiveWorkbook

    For Each sht In wbSource.Sheets
    sht.Copy
    Set wbDest = ActiveWorkbook
    wbDest.SaveAs strSavePath & sht.Name
    wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next

    Application.ScreenUpdating = True

    Exit Sub

    ErrorHandler: 'Just in case something hideous happens
    MsgBox "An error has occurred. Error number=" & Err.Number & ". Error description=" & Err.Description & "."
    End Sub


    Ryan Shuell

    Thursday, December 13, 2012 1:35 AM
  • Did you structure your workbook with a "Main" sheet, and paired sheets with "Manager Name" and "Manager Name_Data"? Did you save the workbook? Did you have a valid folder name in cell A1 of sheet "Main"?
    Thursday, December 13, 2012 1:58 AM
  • Thank you very much for the responses!  My apologies for the delay in responding back as I've been on vacation and I wanted to try to figure out as much on my own so I didn't ask too many questions (I'm a beginner).

    COMMAND BUTTON #1 (to export each grouping to a new file)  This is what I landed on that worked.  Note, "A1" is replaced by "D6"

    Private Sub CommandButton1_Click()
        Dim myS As Worksheet
        Dim strPath As String
        Dim strName As String
       
        strPath = ThisWorkbook.Path
        On Error Resume Next
        ChDir strPath
        MkDir strPath & "\" & Worksheets("Main").Range("D6").Value

        strPath = strPath & "\" & Worksheets("Main").Range("D6").Value   

    'Copy manager pairs

        Sheets(Array("Manager1", "Manager1_Data")).Select
        Sheets(Array("Manager1", "Manager1_Data")).Copy
       

    'Hide data tab in new file
        Sheets("Manager1_Data").Select
        ActiveWindow.SelectedSheets.Visible = False

    'Note:  Worksheets("Manager1").Range("B1") is linked to Main D6

    'Note:  Worksheets("Manager1").Range("C2") is the period (2012  06 + 06)

    'Note:  Worksheets("Manager1").Range("C3") is the manager name (Manger1)

    'Save File As (Filename example: Manager1 - 2012  06 + 06.xlsm)

        "D:\Documents and Settings\" & Worksheets("Manager1").Range("B1") & "\" & Worksheets("Manager1").Range("C3") & " - " & Worksheets("Manager1").Range("C2") & ".xlsm", _
            FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False    

            ActiveWindow.Close

    End Sub

    COMMAND BUTTON #2 (to import the Manager_Data tab into Database onto the All_Data tab)  I was unable to get the code you provided above to work.  In tinkering with the database file, the code below does what I would want it to if I were just copying and pasting from within the same file.  What I need it to do is loop through the directory that was created from CommandButton1 and do it for the individual files.

    'Copy data from Manager file

    Sheets("Manager1_Data").Select
    Worksheets("Manager1_Data").Range("B4:Q18").Select
    Selection.Copy

    'Paste copied data into Dabase file on All_Data Tab

    LR = Sheets("All_Data").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("All_Data").Activate
    Worksheets("All_Data").Range("A" & LR).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Sheets("Main").Select

    End Sub

    Again, thank you very much for your responses. 

    Wednesday, January 02, 2013 6:42 PM
  • Command Button #2 works with the following Code

    Workbooks.Open Filename:= _
            "C\" & Worksheets("Manager1").Range("B1") & "\" & Worksheets("Manager1").Range("C3") & " - " & Worksheets("Manager1").Range("C2") & ".xlsm"""
        Sheets("Manager1_Data").Activate
        Worksheets("Manager1_Data").Range("B4:Q23").Select
        Selection.Copy
        Windows("Forecast Template v2.3.xlsm").Activate
        Sheets("All_Data").Select

        LR = Sheets("All_Data").Range("A" & Rows.Count).End(xlUp).Row + 1
        Sheets("All_Data").Activate
        Worksheets("All_Data").Range("A" & LR).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Sheets("Main").Select

    Tuesday, January 08, 2013 8:10 PM