Macro to save sheets into separated workbooks

[jalrs]

Hello guys,

What im looking for here is to save sheets into different workbooks, where workbook name = sheet name. After doing my research i came to this bit of code, but, unfortunately it only copies the first sheet where the name is <> than "Readme" as code shows.

My code:

Sub CriarWBs()

totalsheets = ThisWorkbook.Sheets.Count

For i = 1 To totalsheets

strsheetname = ThisWorkbook.Sheets(i).Name

If strsheetname <> "Readme" Then

Sheets(strsheetname).Select
Sheets(strsheetname).Copy
ActiveWorkbook.SaveAs Filename:="C:\Users\joafrodrigue\Desktop\teste\Difusao\" & strsheetname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close

End If

Next

End Sub

Thank you very much guys!

 

[mumps]

The formulas will be a problem because when you copy them into a different file, their reference will still refer to the original file. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). Also, when you want to include two sheets in the new file, do you want a new macro to do this?

 

[jalrs]

The formulas will be a problem because when you copy them into a different file, their reference will still refer to the original file. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). Also, when you want to include two sheets in the new file, do you want a new macro to do this?

working on it, im just setting it up so i dont share any confidential data from the company. thank you!

 

[jalrs]

The formulas will be a problem because when you copy them into a different file, their reference will still refer to the original file. Could you upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary). Also, when you want to include two sheets in the new file, do you want a new macro to do this?

See if this works: demo

Side notes:

1-" copy_João_Analise_ST2021_novo2.xlsm " works as the data base where i filter the data according to each department. department is found on column AT as here each department is identified as a football team name

2-"Template2.xlsm" is where my database splits into worksheets with each worksheet corresponding to each department

3-"Readme" worksheet in "Template2.xlsm" is where i sort the buttons to the macro run in order to be faster

4- First block is for spliting, second square is for generating, and finally second block of columns is for mail preview

5-In order to mail preview work, besides changing the path name, i did set it for a folder called "Difusao" inside "demo" folder, so consider just creating it if you wanna check the code.

What i pretend:

1- 1st objective was already achieved that is copying filtered data for each worksheet according to each department.

2- 2nd objective is related to protecting the sheet but as i've opened another thread, ill move on

3- 3rd objective is to split each department worksheet into new workbooks where the new workbook contains each Department Worksheet + TAB_FDB Worksheet. Workbook Name should be the department name, but this is already coded too as you will be able to check. ex: (Porto.xlsx would contain PortoWS and TAB_FDBWS)

4- 4th objective is to send the new workbooks to each departments, so they can fill data on column AX, and the data inserted on AX will autofill column AY, according to TAB_FDB, and it's where the problem resides at the moment.

Regarding your last question, i didnt get it properly i think. the macro that does it can be the same as 3rd objective one. it's the module called "criarWBS". problem here is that it only grabs each department sheet instead of each department sheet + Tab_fdb sheet so end users can perform the 4th goal.

Additionally i could say that all departments will have a different table on TAB_FDB sheet but thats just a matter of adding it afterwards and setting up the vlookup accordingly. I just need to make sure that when i send them the new workbooks, the formula still prevails so they can perform their job.

Thank you, hope i was clear enough, if not let me know.

 

[mumps]

This macro will create a new workbook with the two sheets:

Sub CriarWBs()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With srcWB
        For Each ws In .Sheets
            If ws.Name <> "Readme" And ws.Name <> "Resumo" And ws.Name <> "TAB_FDB" Then
                .Sheets(Array(ws.Name, "TAB_FDB")).Copy
                With ActiveWorkbook
                    .SaveAs Filename:="C:\Users\joafrodrigue\Desktop\demo\Difusao\" & ws.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    .Close False
                End With
            End If
        Next ws
    End With
    Application.ScreenUpdating = True
End Sub

 

[jalrs]

This macro will create a new workbook with the two sheets:

Sub CriarWBs()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With srcWB
        For Each ws In .Sheets
            If ws.Name <> "Readme" And ws.Name <> "Resumo" And ws.Name <> "TAB_FDB" Then
                .Sheets(Array(ws.Name, "TAB_FDB")).Copy
                With ActiveWorkbook
                    .SaveAs Filename:="C:\Users\joafrodrigue\Desktop\demo\Difusao\" & ws.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    .Close False
                End With
            End If
        Next ws
    End With
    Application.ScreenUpdating = True
End Sub

works wonderfully, thank you very much mumps!

 

[jalrs]

This macro will create a new workbook with the two sheets:

Sub CriarWBs()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With srcWB
        For Each ws In .Sheets
            If ws.Name <> "Readme" And ws.Name <> "Resumo" And ws.Name <> "TAB_FDB" Then
                .Sheets(Array(ws.Name, "TAB_FDB")).Copy
                With ActiveWorkbook
                    .SaveAs Filename:="C:\Users\joafrodrigue\Desktop\demo\Difusao\" & ws.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    .Close False
                End With
            End If
        Next ws
    End With
    Application.ScreenUpdating = True
End Sub

hey mumps sorry to bother one last time.

Regarding the vlookup formula on column AY? Nothing that we can do, so when i create each workbook and send them to my coworkers, they can just use column AX and AY gets autofilled? Is there a way? Because all works except that vlookup doesnt lock when each wb is created

i know you said that was more complicated, wondering if there's an alt way? like would it be possible to macro the vlookup, so it follows with the email?

Thanks

 

[mumps]

This version will insert the formula in AY.

Sub CriarWBs()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With srcWB
        For Each ws In .Sheets
            If ws.Name <> "Readme" And ws.Name <> "Resumo" And ws.Name <> "TAB_FDB" Then
                .Sheets(Array(ws.Name, "TAB_FDB")).Copy
                .Sheets(ws.Name).Range("AY2", .Sheets(ws.Name).Range("AY" & Rows.Count).End(xlUp)).Formula = "=IF(AX2="","",VLOOKUP(AX2,TAB_FDB!A:B,2,0))"
                With ActiveWorkbook
                    .SaveAs Filename:="C:\Users\joafrodrigue\Desktop\demo\Difusao\" & ws.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    .Close False
                End With
            End If
        Next ws
    End With
    Application.ScreenUpdating = True
End Sub

 

[jalrs]

This version will insert the formula in AY.

Sub CriarWBs()
    Application.ScreenUpdating = False
    Dim ws As Worksheet, srcWB As Workbook
    Set srcWB = ThisWorkbook
    With srcWB
        For Each ws In .Sheets
            If ws.Name <> "Readme" And ws.Name <> "Resumo" And ws.Name <> "TAB_FDB" Then
                .Sheets(Array(ws.Name, "TAB_FDB")).Copy
                .Sheets(ws.Name).Range("AY2", .Sheets(ws.Name).Range("AY" & Rows.Count).End(xlUp)).Formula = "=IF(AX2="","",VLOOKUP(AX2,TAB_FDB!A:B,2,0))"
                With ActiveWorkbook
                    .SaveAs Filename:="C:\Users\joafrodrigue\Desktop\demo\Difusao\" & ws.Name & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    .Close False
                End With
            End If
        Next ws
    End With
    Application.ScreenUpdating = True
End Sub

Hey mumps,

Sadly it didnt. What i noticed while testing:

When i run the macro, after going back to the "Template" WB, where i shouldnt have any output on column AY and column AX, i get returned a "FALSE" on row n2 for AY column.

Note that the output on column AX and AY are for my end user, so they will fill column AX based on the dropdown list assigned to columnA of TAB_FDB and get returned, automatically, a value based on the seletion, according to column B of TAB_FDB.

Thats their only job, fill column AX and watch AY return a value according to their selection. Therefore, they must send me the file, so i can archive it.

Just wrote it for context, might let it more clear

Could it be due to excel formula? Do i have to clear the excel formula on column AY and save the file before running the macro?

thanks

 

[mumps]

When I tested the macro it inserted the formula in AY. When I entered a value in AX, the value in AY was returned correctly. What does the formula in AY look like after you run the macro?

 

[jalrs]

Ok so:

on 1st attachment (1) i show you what the formula on AY looks like on my TemplateWB
on 2nd attachment (2) you can see that the value is returned correctly
on 3rd attachment (3) i go to readmeWS on TemplateWB and perform the macro that generates each department ws as a new workbook with TAB_FDB ws in each
on 4th attachment (4) i open the departmentWB (ApoioSP here, in demo = Porto) and the value a doesnt get returned on AY as b