Splitting Worksheets out to separate Workbooks

[silverlucky5]

Hi, I hope someone out there can help me out with this problem. Here is what I am attempting to do:

1. I have a workbook that contains 4 worksheets.
2. The worksheets are named as follows:
1^st worksheet name = Medical
2^nd worksheet name = RX
3^rd worksheet name = Dental
4^th worksheet name = Vision
3. I want to save each worksheet as a separate csv file with the date and time as part of the file name..
4. At first I thought that using the worksheet name would be the best way to name the new csv file.
For example, the csv file for the first worksheet would be called “C:\Medical yyyymmdd-hhmmss .csv. I used the code below (cutting and pasting from various snippets of code I found) and that worked fine.
5. But it turns out that the worksheet names cannot be used to name the csv files and I need to provide specific names for each worksheet.
6. So I thought that I could embed some “If..Then..Else” statements while still in the For..Next Loop. For example, I want to do something like this:
If first worksheet (i = 1) THEN save as a certain name ELSE if worksheet is the second worksheet (i=2) THEN save as another name ELSE, etc.
7. My problem is that I am quite a novice and just learning VBA and don’t know how to embed the “If..Then..Else” statements while still in the For..Next loop or even if I CAN embed it. Any help you can provide will be greatly appreciated! Thanks..

Here is the code I am using

Option Explicit

Sub SplitWorkbookTest()

Application.DisplayAlerts = False

Dim i As Long
For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With

ActiveWorkbook.SaveAs Filename:="C:\" & ActiveSheet.Name & " " & _
Format(Date, "yyyymmdd") & "-" & Format(Time, "hhnnss") & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Next i

ActiveWorkbook.Close False

Application.DisplayAlerts = True

End Sub
[FONT=&quot]
[/FONT]

 

[AlphaFrog]

Sub SplitWorkbookTest()

Application.DisplayAlerts = False

Dim i As Long, [COLOR="Red"]OtherName As String[/COLOR]
For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
[COLOR="Red"]Select Case i
    Case 1: OtherName = [COLOR="Blue"]"Med"[/COLOR]
    Case 2: OtherName = [COLOR="Blue"]"Rex"[/COLOR]
    Case 3: OtherName = [COLOR="Blue"]"Dent"[/COLOR]
    Case 4: OtherName = [COLOR="Blue"]"Vis"[/COLOR]
End Select[/COLOR]
ActiveWorkbook.SaveAs Filename:="C:\" & [COLOR="Red"]OtherName[/COLOR] & " " & _
Format(Date, "yyyymmdd") & "-" & Format(Time, "hhnnss") & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Next i

ActiveWorkbook.Close False

Application.DisplayAlerts = True

End Sub

 

[silverlucky5]

Sub SplitWorkbookTest()

Application.DisplayAlerts = False

Dim i As Long, [COLOR=Red]OtherName As String[/COLOR]
For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
[COLOR=Red]Select Case i
    Case 1: OtherName = [COLOR=Blue]"Med"[/COLOR]
    Case 2: OtherName = [COLOR=Blue]"Rex"[/COLOR]
    Case 3: OtherName = [COLOR=Blue]"Dent"[/COLOR]
    Case 4: OtherName = [COLOR=Blue]"Vis"[/COLOR]
End Select[/COLOR]
ActiveWorkbook.SaveAs Filename:="C:\" & [COLOR=Red]OtherName[/COLOR] & " " & _
Format(Date, "yyyymmdd") & "-" & Format(Time, "hhnnss") & ".csv", FileFormat:=xlCSV
ActiveWindow.Close
Next i

ActiveWorkbook.Close False

Application.DisplayAlerts = True

End Sub

Eureka! I can't thank you enough...this worked perfectly!! Thank you Thank you Thank you

 

[silverlucky5]

Hi, Some facts have changed since the previous post……

1. I have a workbook that contains 6 worksheets.
2. The worksheets are named as follows:
1^st worksheet name = Summary Numbers
2^nd worksheet name = Medical
3^rd worksheet name = Rx
4^th worksheet name = Dental
5^th worksheet name = Vision
6^th worksheet name = Miscellaneous
3. I want to save the 2^nd, 3^rd , 4^th and 5^th worksheets as csv files. I do not want to save the 1^st and 6^th worksheets at all. The 2^nd, 3^rd, 4^th and 5^th worksheets should be named as follows:
2^nd worksheet saved name = Data.csv
3^rd worksheed saved name = Data_Rx.csv
4^th worksheet saved name = Data_DN.csv
5^th worksheet saved name = Data_VS.csv
4. Originally the workbook only contained the 2^nd, 3^rd, 4^th and 5^th worksheets, so the code below (that AlphaFrog so graciously helped me with) worked fine

Sub SplitWorksheets()

Application.DisplayAlerts = False

Dim i As Long, OtherName As String

For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy

Select Case i
Case 1: OtherName = ""
Case 2: OtherName = "_Rx"
Case 3: OtherName = "_DN"
Case 4: OtherName = "_VS"
End Select

ActiveWorkbook.SaveAs Filename:="C:\Data" & OtherName & ".csv", FileFormat:=xlCSV

ActiveWindow.Close
Next i
ActiveWorkbook.Close False
Application.DisplayAlerts = True

End Sub

5. But now with the addition of worksheets 1 and 6, I want to name the new separate csv files based on the worksheet names in the workbook but only for worksheets 2, 3, 4 and 5.
Example:
If worksheet name = Medical, then save worksheet as separate csv file with the name of “Data.csv.
If worksheet name = Rx, then save worksheet as separate csv file of “Data_Rx.csv”
If worksheet name = Dental, then save worksheet as separate csv file of "Data_DN.csv"
If worksheet name = Vision, then save worksheet as separate csv file of "Data_VS.csv"

(Note that for Medical worksheet, nothing additional is appended to the file name.)

6. Not sure how to do this. Should I use nested “Select Case”s? I tried but it just isn’t working.
7. As before, any help you can provide will be greatly appreciated! Thanks..

 

[Norie]

Try this.

Option Explicit
 
Sub SplitSomeWSs()
Dim wbNew As Workbook
Dim wbThis As Workbook
Dim ws As Worksheet
Dim strNewName As String
Dim strPath As String
'Set wbThis = ThisWorkbook
 
strPath = wbThis.Path
 
Application.DisplayAlerts = False
 
For Each ws In wbThis.Worksheets

    Select Case ws.Name

        Case "Medical"
            strNewName = "Data"
        
            
        Case "Rx"
            strNewName = "Data_Rx"
        
        Case "Dental"
            strNewName = "Data_DN"
        
        Case "Vision"
            strNewName = "Data_VS"
        
        Case Else
            ' do nothing
            strNewName = "Don't Copy"
    End Select
    
    If strNewName <> "Don't Copy" Then
        ws.Copy
        Set wbNew = ActiveWorkbook
        
        wbNew.SaveAs strPath & "\" & strNewName, FileFormat:=xlCSV
        
        wbNew.Close
        
    End If
        
Next ws
 
Application.DisplayAlerts = True
 
End Sub

 

[silverlucky5]

<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]-->Hi Norie,


Thanks so much for the response and sorry it took so long to respond back. When I tried running the code you provided, it didn't seem to create the csv files. But I saw what you did with the "If Then" and you gave me the idea to incorporate your logic into the code I was using before, as shown below:


<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> </w:Compatibility> <w:BrowserLevel>MicrosoftInternetExplorer4</w:BrowserLevel> </w:WordDocument> </xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" LatentStyleCount="156"> </w:LatentStyles> </xml><![endif]--><!--[if gte mso 10]> <style> /* Style Definitions */ table.MsoNormalTable {mso-style-name:"Table Normal"; mso-tstyle-rowband-size:0; mso-tstyle-colband-size:0; mso-style-noshow:yes; mso-style-parent:""; mso-padding-alt:0in 5.4pt 0in 5.4pt; mso-para-margin:0in; mso-para-margin-bottom:.0001pt; mso-pagination:widow-orphan; font-size:10.0pt; font-family:"Times New Roman"; mso-ansi-language:#0400; mso-fareast-language:#0400; mso-bidi-language:#0400;} </style> <![endif]--> Option Explicit
Sub SplitSomeWSs()

Application.DisplayAlerts = False
Dim i As Long, OtherName As String
For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Copy
Select Case i
Case 1: OtherName = "Don't Copy"
Case 2: OtherName = ""
Case 3: OtherName = "_RX"
Case 4: OtherName = "_DN"
Case 5: OtherName = "_VS"
Case 6: OtherName = "Don't Copy"
End Select

If OtherName <> "Don't Copy" _
Then
ActiveWorkbook.SaveAs Filename:="C:\Data" & OtherName & ".csv", FileFormat:=xlCSV
End If


ActiveWindow.Close
Next i
ActiveWorkbook.Close False
Application.DisplayAlerts = True

End Sub

Your code is much slicker than mine, but the above seems to be working, so I think I'll just leave well enough alone. Again, thanks so much for your help and brain power!