Troubles when Creating workbooks from worksheets.

dilshod_k · Jan 21st 2021

Hello everyone,

I've got sub that creates workbooks from sheets. My sheets have names in the form of dates in with format yyyy.mm.dd (2021.01.15 - for example).

Routine does creates files, but they come with names like 2021.01.20 without extensions (it should be 2021.01.20.xlsx) and can not be opened by Excel. When I try to rename them manually, they open with sheets empty, without any data. I would be grateful if you could help me to find out reason for that. Thanks in advance.

Dilshod

Code

Sub CreateWorkbookFromSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim path As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
Set wb = Workbooks.Add
wb.SaveAs path & "\" & ws.Name
ws.Copy before:=wb.Worksheets(1)
wb.Close savechanges = True
End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Display More

**Carim** · Jan 21st 2021

Hello,

A quick fix could be the following :

Code

Sub NameModif()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
ws.Name = Replace(ws.Name, ".", "_")
End If
Next ws
End Sub

Hope this will help

dilshod_k · Jan 21st 2021

Quote from Carim

Hello,

A quick fix could be the following :

Hello Carim,

Thanks very much for your help. It now does create xlsx files BUT, they still come up empty...

I've attached sample workbook with table, would you be able to make amendments to the code so that files would come with tables in them?

Thanks in advance for your help.

Dilshod

Code

Sub CreateWorkbookFromSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim path As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
ws.Name = Replace(ws.Name, ".", "_")
Set wb = Workbooks.Add
wb.SaveAs path & "\" & ws.Name
ws.Copy before:=wb.Worksheets(1)
wb.Close savechanges = True
End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Display More

**Carim** · Jan 21st 2021

Lines 12 to 20 in your macro ...

below is a tiny modification ... the instruction copying the worksheet comes before the instruction which saves the workbook ...

Code

Sub Test()
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
ws.Name = Replace(ws.Name, ".", "_")
Set wb = Workbooks.Add
ws.Copy before:=wb.Worksheets(1)
wb.SaveAs Path & "\" & ws.Name
wb.Close savechanges = True
End If
Next ws
End Sub

Display More

Hope this will help

dilshod_k · Jan 21st 2021

Quote from Carim

Lines 12 to 20 in your macro ...

below is a tiny modification ... the instruction copying the worksheet comes before the instruction which saves the workbook ...

Hope this will help

Display More

Now it works perfectly well. Thanks a lot!

Appreciate your help.

Dilshod

**Carim** · Jan 21st 2021

You are very welcome

Thanks a lot both for your Thanks ... AND for the Like

**royUK** · Jan 22nd 2021

If you use ws.Move it will automatically move that sheet to a new workbook, which would simply need renaming.

Code

Option Explicit
Sub CreateWorkbookFromSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim path As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
ws.Move
ActiveWorkbook.SaveAs path & "\" & ws.Name
ActiveWorkbook.Close True
End If
Next ws
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Display More

dilshod_k · Jan 23rd 2021

Quote from royUK

If you use ws.Move it will automatically move that sheet to a new workbook, which would simply need renaming.

Hi royUK,

Thanks for your help. The code moved two (out of 30) sheets to new books and gave Automation error at line#23. Apart from that all files with names Book # will have to be renamed manually, when I'll be processing hundreds of sheets it is going to be tedious. Is it possible to give file names the same as sheet names and close them automatically? Thanks again for your help.

Dilshod

**royUK** · Jan 23rd 2021

The code should be saving as the worksheet's name

Code

Sub CreateWorkbookFromSheets()
Dim ws As Worksheet
Dim wb As Workbook
Dim path As String, nm As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
nm = ws.Name
ws.Copy
ActiveSheet.Name = nm
''/// this line saves the new workbook with the sheet name
ActiveWorkbook.SaveAs path & "\" & nm & ".xlsx", FileFormat:=51
''/// this line closes the new workbook and saves it
' ActiveWorkbook.Close True
End If
Next ws
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Display More

dilshod_k · Jan 23rd 2021

Quote from royUK

The code should be saving as the worksheet's name

Hello royUK,

The code is working perfectly well. I would not be able to solve it on my own. Advantage is that I do not have to rename sheets any more to save files. Thanks for explicit comments in the code. Highly appreciate it.

Dilshod

**royUK** · Jan 24th 2021

Pleased to help.

Troubles when Creating workbooks from worksheets.

Share

Tags