VBA Code: To create Multiple file based on the list

[Monty]

Hello Everybody!

Am working on some thing where i need to create out put files like one and two

As per the screenshot.

1 ) We will be pasting the path of the path of the master file to be opened.

2) output folder path where output files will be saved.

3) check list for the names like one and two.

4) check for the file names to be created

5) As per the master file will have all the sheets but when creating file "one" we should ensure we have only 1, one and 3 sheets only

"Two" we should ensure we have only Two, 6 and 7 sheets only

So master file consists all sheets but based on the conditions as per the 5the point should create file called "one" and should enusre only 1,one and 3 sheets only and so on.


Hope this is clear...Advise/Help much appreciated.



Attatched files
1) Macro file -> Open the Master file and create two file "one" and "Two" with respective sheets as per the list.
2) Master file


Thanks
Monty

 

[Marc L]

Hi !

To paste to the worksheet module of code workbook (Edit v2) :​

Sub CreateWorkbooks()
    Dim F$, P$, C%, N$, V, R&
        F = [B3].Value
        P = [B5].Value
        C = F = ""
     If C Or P = "" Then Beep: Cells(5 + 2 * C, 2).Select: Exit Sub
     If Right(P, 1) <> "\" Then P = P & "\"
        C = Dir(F) = ""
     If C Or Dir(P, vbDirectory) = "" Then Beep: Cells(5 + 2 * C, 2).Select: Exit Sub
        N = Mid(F, InStrRev(F, "\") + 1)
        V = Evaluate("ISREF('[" & N & "]" & [B12].Text & "'!A1)")
     If IsError(V) Then Beep: [B12].Select: Exit Sub
     If V = False Then GetObject F
    With Application
         .DisplayAlerts = False
        .ScreenUpdating = False
        On Error GoTo Fin
    For C = 2 To 3
            Workbooks(N).Worksheets(Cells(12, C).Text).Copy
        For R = 13 To Cells(11, C).End(xlDown).Row
            Workbooks(N).Worksheets(Cells(R, C).Text).Copy , ActiveWorkbook.Worksheets(R - 12)
        Next
            ActiveWorkbook.SaveAs P & Cells(6 + C, 3).Value, 51
            ActiveWorkbook.Close
    Next
Fin:
        If Err.Number Then Beep: Debug.Print Err.Number; Err.Description Else Me.Activate
        If V = False Then Workbooks(N).Close
         .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
            Dim obj As Object, V
    Select Case Target(1).Address(False, False)
        Case "B2", "B3"
            Cancel = True
            V = Application.GetOpenFilename("Excel workbooks (*.xlsx), *.xlsx")
            If V = False Then Exit Sub
            [B3].Value = V
            V = Left(V, InStrRev(V, "\"))
            If V <> [B5].Value Then If MsgBox("Paste " & V & vbLf & "to Output folder ?", 36, "  Folder …") = vbYes Then [B5].Value = V
        Case "B4", "B5"
            Cancel = True
            Set obj = CreateObject("Shell.Application").BrowseForFolder(0, vbLf & "Output folder :", 1, "")
            If Not obj Is Nothing Then [B5].Value = obj.Self.Path: Set obj = Nothing
    End Select
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Monty]

Hello Marc.



Beautiful way of writing code..

Some how unable to create with the filenames mentioned in the macro file.


We are not writing code in the master file as it is really huge..
So decided to open the master file from a simple macro file where we mention the file path to open.

1) From macro file open the master file and save it as with the mentioned file name and keep only mentioned sheets.

2) list to delete or to keep the sheets are upto 15 sheets.


Problem is when you open master file and save it as file required the file is no more available...so need to reopen the master file again...How to avoid this.

Thanks Monty!

 

[Marc L]

As my code does not save master file
if you just follow direction written just before code !

The trap was your numeric worksheets names.
Try updated code in post #2, paste it as per direction …
​

 

[Monty]

Thank you marc as always.

 

[Monty]

Hello Marc.

Can you please amend the macro.. provided by one of our forum welknown member Yasser as per my requirement...Of course tried before asking..

Please find attached.

 

[Marc L]

As my code fills the purpose of this thread, which code for which purpose ?
Why don't you directly ask to its author ?

For another purpose than the original of this thread
it's time to open a new thread …
​

 

[YasserKhalil]

Hello Mr. Monty
I have downloaded your files in your previous post and tested it and I think it is working well.
Can you explain more the problem or the modifications that you need?

 

[Monty]

YasserKhalil

Thank you so very much for followup...Macro is working fine..

Wanted the way format provided in post 1.

Still trying to figure out..

 

[YasserKhalil]

Try this modification

Sub ExportSheetsToNewWorkbooks()
    Dim wbkIn      As Workbook
    Dim wbkOut      As Workbook
    Dim wshData    As Worksheet
    Dim strIn      As String
    Dim strPath    As String
    Dim strSheet    As String
    Dim strOut      As String
    Dim r          As Long
    Dim m          As Long
    Dim c          As Long
    Dim n          As Long

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wshData = ThisWorkbook.Worksheets("Sheet1")
    strIn = wshData.Range("B3")
    Set wbkIn = Workbooks.Open(Filename:=strIn)
    strPath = wshData.Range("B5")
    n = wshData.Cells(11, wshData.Columns.Count).End(xlToLeft).Column

    For c = 2 To n
        Set wbkOut = Workbooks.Add(xlWBATWorksheet)
        m = wshData.Cells(wshData.Rows.Count, c).End(xlUp).Row
        For r = 12 To m
            strSheet = wshData.Cells(r, c).Value
            wbkIn.Worksheets(strSheet).Copy After:=wbkOut.Worksheets(wbkOut.Worksheets.Count)
        Next r
        wbkOut.Worksheets(1).Delete
        strOut = wshData.Cells(c + 6, 3).Value & ".xlsx"
        wbkOut.SaveAs Filename:=strPath & strOut, FileFormat:=xlOpenXMLWorkbook
        wbkOut.Close
    Next c

ExitHandler:
    On Error Resume Next
    wbkIn.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

 

[Marc L]

Hi Yasser !

Removing all the useless, you could achieved the same
with only 3 variables and an unique handler …
As you create variables for objects which already have a variable object !

And you fell into the worksheet name trap (see post #4),
just compare result with my code …

Monty,
is the worksheets order in destination workbooks is important
or can it stay the same as original workbook ?
​

 

[Monty]

Hello Marc.


View attachment 40818
Beautiful way of writing code..

Some how unable to create with the filenames mentioned in the macro file.


We are not writing code in the master file as it is really huge..
So decided to open the master file from a simple macro file where we mention the file path to open.

1) From macro file open the master file and save it as with the mentioned file name and keep only mentioned sheets.

2) list to delete or to keep the sheets are upto 15 sheets.


Problem is when you open master file and save it as file required the file is no more available...so need to reopen the master file again...How to avoid this.

Thanks Monty!

Hello Marc.

Macro code will be in a separate workbook as we can do any changes in the master file.

1) Open master file
2) extract the sheets required as per my screenshot and save it.

We are almost there and trying to fix it now... Thanks to Yasserr and Marc for the quick help.


Thanks.

 

[Marc L]

Since the beginning my code does all you described …

I just wanna know about worksheets order in new workbooks ?!​

 

[Monty]

Hello Marc.

Not so important...Order is fine.

 

[Marc L]

If order no matters I can mod my first original code to copy at once
worksheets in each new workbook without falling in trap of names,
order in this case stays from source master file …

But as you posted two different layouts, which one is the real one,
from post #1 or post #6 ?
As on my side I prefer a horizontal layout for files names & worksheets …
​

 

[Monty]

Yes Marc.... Changing my format...Thanks for the help.