Macro to create new workbooks based on cell values

[Paco2k]

Hi everyone!

Hope you can help me with this as I found a code to create new workbooks but I cant's seem to bring it together.

I have a workbook to create folders based on some data I paste into a group of rows. For each row it creates a folder. I got this to work quite well but now I also want to create a workbook based on another worksheets when creating these folders.

The whole idea is to create multiple new workbooks named after specific values in cells F5:F19, and save them accordingly in the folders created for each row. Folder's path is set in cells B45:B60. Moreover, these new workbooks should be made of sheets "sheet1", "sheet2" and "sheet3" from the current workbook. Note some times only some of the rows contain data and for the ones that are blank nothing should be done.

So in other words, I want to create new workbooks with sheets "sheet1", "sheet2" and "sheet3", named after a specific value in range F5:F19, and then saved in a corresponding folder specified in range B45:B60.

I was going to include a code for creating new workbooks but I thought it wold be "cleaner" if you could provide what you use.

Also hope I explained myself

Thank you,

Paco.

 

[Andrew Poulsom]

It may help to see your code. By the way, B45:B60 has more rows than F5:F19.

 

[Paco2k]

Thanks,

To create the folders I use the following code by Jerry Beaucaire:

Sub MakeDirectories()
'Author:    Jerry Beaucaire
'Date:      7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String


Set Paths = Range("B45:B60").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next
    
    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        pBuf = ""
    Next Path


Set Paths = Nothing


End Sub

Now as for setting the path, I enter main data into cells B5:N20 which in turn via formula in B28:B43 gives the full folder path. Because I seemed to be unable to run the above macro on the latter range due to being formulas, I added another macro to copy/paste as values in B45:B60, which are the cells I use to create the folders.

So then I created another macro to call these two (plus another to clear cells used with pasted values). I'm thinking of including in this macro the one to create the workbooks after folders have been created.

Sub CallMyMacros()


Application.ScreenUpdating = False


    Call CopyPath
    Call MakeDirectories
    Call Clear_Range
    
Application.ScreenUpdating = True




End Sub

Also thanks for noting the mistake between the ranges

 

[Andrew Poulsom]

Maybe try:

Sub MakeDirectories()
'Author:    Jerry Beaucaire
'Date:      7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String
Dim wb      As Workbook
Set Paths = Range("B45:B60").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next
    
    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        Set wb = Workbooks.Add
        wb.SaveAs pBuf & Application.PathSeparator & Path.Offset(-30, 4).Value
        wb.Close
        pBuf = ""
    Next Path

Set Paths = Nothing

End Sub

 

[Paco2k]

Well I tried your suggestion but it only creates the folders... it appears to open and close the new workbooks but doesn't save them (maybe it has to do with the reference in SaveAs?) Don't know if you would have any other suggestion... also the table is not always filled and accordingly don't need to create a file for all the rows if these are empty.

Anyways, thank you again.

 

[Andrew Poulsom]

What happens if you comment out this line?

On Error Resume Next

 

[jbeaucaire]

Assuming the template file is in a static location and the name of the file you want to create is always in the cell to the right of the PATH string, perhaps this:

Sub MakeDirectoriesAndFiles()
'Author:    Jerry Beaucaire
'Date:      7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String
Dim Template As String

Template = "C:\MyDocuments\MyTemplate.xls"          'this is the file that will be copied

Set Paths = Range("B45:B60").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next

    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        Next pNum
        pBuf = ""

        FileCopy Template, Path & Path.Offset(, 1).Value & ".xls"

    Next Path

Set Paths = Nothing

End Sub

 

[Paco2k]

Thanks Jerry for your response, I tried as you suggested and was able to create/copy template file with correct name but it was put one folder below the last in the path. I tried the following to solve this and got the file to be put in the correct folder but then the file wasn't being named anymore:

Option Explicit

Sub MakeDirectories()
'Author:    Jerry Beaucaire
'Date:      7/11/2010
'Summary:   Create directories and subdirectories based
'           on the text strings listed in column A
'           Parses parent directories too, no need to list separately
'           10/19/2010 - International compliant
Dim Paths   As Range
Dim Path    As Range
Dim MyArr   As Variant
Dim pNum    As Long
Dim pBuf    As String
Dim Delim   As String
Dim Template As String


Template = "C:\FOLDERS\case.xlsx" 'this is the file that will be copied


Set Paths = Range("B45:B60").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next


    For Each Path In Paths
        MyArr = Split(Path, Delim)
        pBuf = MyArr(LBound(MyArr)) & Delim
        For pNum = LBound(MyArr) + 1 To UBound(MyArr)
            pBuf = pBuf & MyArr(pNum) & Delim
            MkDir pBuf
        
        Next pNum
        
        pBuf = ""
        
        FileCopy Template, Path [COLOR=#ff0000]& Delim & [/COLOR]Path.Offset(, 1).Value & ".xlsx"
                
        
    Next Path


Set Paths = Nothing


End Sub