Create New Workbook from existing Tab

[NM123]

Hi All,

I want to create new workbooks from an excel sheet which is having more than 1 sheet. Through VBA i want to create each new work sheet and save as local file where the Parent file is saved.

I have attached an excel sheet for example and understanding along with the partial code. The sheet contains more than 1 tab named as Case-1,Case-2 etc.... I want each tab of the sheet to stored as independent Workbook rather than in the Tabs.

i need this very urgently. Please let me know if you need any other information.

Regards,
NM123

[Kenneth Hobs]

[VBA]Sub CaseSheetsAsWorkbooks()
Dim ws As Worksheet, destFolder As String
destFolder = ThisWorkbook.Path & "\"
For Each ws In Worksheets
If Left(ws.Name, 4) = "Case" Then
With ws
.SaveAs destFolder & .Name
End With
End If
Next ws
End Sub[/VBA]

[NM123]

Hi Kenneth,
Thanks for your response. I have excuted the code snippet that you have provided, but is not helping me completely. I mean it is saving the worksheet file as per the sheet name. But it is also containing the other worksheets, which i dont want and it should save as the independent Workbook only i.e no other sheet it should have. Below is the code snippet to change the File name from Case-1(e.g.) to new Workbook.

strFileName = Sheets(shtSheetName.Name).Range("B2").Value & "_" & Sheets(shtSheetName.Name).Range("B3")
strFilePath = strFilePath & "\" & strFileName

Waiting for your response.
Regards,
NM123

[vba]Sub CaseSheetsAsWorkbooks()
Dim ws As Worksheet, destFolder As String
destFolder = ThisWorkbook.Path & "\"
For Each ws In Worksheets
If Left(ws.Name, 4) = "Case" Then
With ws
.SaveAs destFolder & .Name
End With
End If
Next ws
End Sub[/vba]

[Kenneth Hobs]

Sorry, I did not check the output as I usually do. This can be made faster using some other methods but this is easy to understand. If your filename has illegal characters, it will fail. Some of that can be checked if needed.

[vba]Option Explicit
Sub CaseSheetsAsWorkbooks()
Dim ws As Worksheet, destFolder As String
Dim wb As Workbook, wbs As Worksheet, wbName As String
destFolder = ThisWorkbook.Path & "\"
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With

For Each ws In Worksheets
If Left(ws.Name, 4) = "Case" Then
With ws
wbName = destFolder & .Range("B2").Value2 & "_" & .Range("B3").Value2 & ".xlsx"
If Dir(wbName) <> "" Then Kill (wbName)
Set wb = Workbooks.Add
.Copy wb.Worksheets(1)
For Each wbs In wb.Sheets
If wbs.Name <> .Name Then wbs.Delete
Next wbs
wb.Close True, wbName
End With
End If
Next ws

With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
[/vba]

[NM123]

Thanks a lot Sir,
It really helped me !!!

1 more thing i how can i rename the Sheet Name( For e.g. Sheet1) after it converts to New Workbook.

regards,
NM123

Sorry, I did not check the output as I usually do. This can be made faster using some other methods but this is easy to understand. If your filename has illegal characters, it will fail. Some of that can be checked if needed.

[vba]Option Explicit

Sub CaseSheetsAsWorkbooks()
Dim ws As Worksheet, destFolder As String
Dim wb As Workbook, wbs As Worksheet, wbName As String

destFolder = ThisWorkbook.Path & "\"

With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With

For Each ws In Worksheets
If Left(ws.Name, 4) = "Case" Then
With ws
wbName = destFolder & .Range("B2").Value2 & "_" & .Range("B3").Value2 & ".xlsx"
If Dir(wbName) <> "" Then Kill (wbName)
Set wb = Workbooks.Add
.Copy wb.Worksheets(1)
For Each wbs In wb.Sheets
If wbs.Name <> .Name Then wbs.Delete
Next wbs
wb.Close True, wbName
End With
End If
Next ws

With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

[/vba]

[Kenneth Hobs]

Please do not quote and thereby repeat a whole post or a whole code unless you really need to.

Before the wb.close line:
[VBA] wb.Worksheets(1).Name = Format(Date, "mm-dd-yyyy")[/VBA]

[aleenkhan]

Its really helpfull. Thanks