I have found a decent solution Saving excel worksheet to CSV files with filename+worksheet name using VB for saving all worksheets in a workbook as CSV files. However, I would like to be able to modify this code to only save worksheets where the sheet name ends with _t.
I am using the following code:
Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
Can this be done?
Use the Right or Instr-Method on the worksheet.name property to get the last characters / check if your searchstring is exisiting.
In your for each-loop add the following code:
If Right(WS.name, 2) = "_t" Then
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
End if
Related
I have a macro that fills in then saves tracking numbers to a .csv file and I want to have Worksheets(1) active when I close the Workbook. The problem I am having is that it will save and close the Workbook on Worksheets("Tracking"). I have tried to select or activate Worksheets(1) then re-save and close but I can't seem to have it work.
Here is my code for saving the .csv file and closing the workbook.
Dim ws as Worksheet
Set ws = ActiveWorkbook.Worksheets("Tracking")
ws.Select
Dim sFileName As String
sFileName = ActiveWorkbook.path & "\" & Left(ws.name, InStr(1, ActiveWorkbook.name, ".") - 1) & ".csv"
Application.DisplayAlerts = False
'Save Current workbook just in case latest additions not saved.
ActiveWorkbook.Save
'Now create a CSV of the active sheet.
ws.SaveAs Filename:=sFileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True 'turn it back on
ActiveWorkbook.Close True 'Close and quit excel
Application.Quit
If all you are trying to do is have excel open on a specific sheet, you can try using the built-in workbook_open.
Private Sub Workbook_Open()
Sheets(“Sheet1”).Select
End Sub
The changes for selecting the sheet and the range.
Sub Macro1()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet2")
ws.Select
Dim sFileName As String
sFileName = ActiveWorkbook.Path & "\" & Left(ws.Name, InStr(1, ActiveWorkbook.Name, ".") - 1) & ".csv"
Application.DisplayAlerts = False
'Save Current workbook just in case latest additions not saved.
Sheets(1).Select
Range("A1").Select
ActiveWorkbook.Save
'Now create a CSV of the active sheet.
ws.SaveAs Filename:=sFileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True 'turn it back on
ActiveWorkbook.Close True 'Close and quit excel
Application.Quit
End Sub
I have been using the code below to successfully create and save a new workbook for each worksheet in my workbook. When I try to run it now I get an error "Compile Error Wrong number of arguments or invalid property assignments". I cannot see why it is not working now; it did before. I do want the date in the final name. If I run the code with the wb.SaveAs line marked with ' it works fine. It doesn't seem to like the format part now. Any ideas what is different and why? Thank-you.
Sub Make_Workbooks()
Dim ws As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For Each ws In ThisWorkbook.Worksheets
Set wb = Workbooks.Add
'wb.SaveAs ThisWorkbook.Path & "\" & ws.Name
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd") & ".xlsx"
ws.Copy Before:=wb.Worksheets(1)
wb.Close SaveChanges:=True
Next ws
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
The syntax used to use the SaveAs should be FileName, FileFormat, ....
In your code it should be:
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook
(xlOpenXMLWorkbook = ".xlsx")
If you will run your code a few times every day, you will get a message if you want to overwrite the existing file since ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd") will have the same String on the same day.
If you want to automatically overwrite your previous file, then add the line Application.DisplayAlerts = False.
Code
Option Explicit
Sub Make_Workbooks()
Dim ws As Worksheet
Dim wb As Workbook
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For Each ws In ThisWorkbook.Worksheets
Set wb = Workbooks.Add
' add this line to automatically overwrite the exisitng file (not getting the MsgBox on every time)
Application.DisplayAlerts = False
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Date, "yyyy-mm-dd"), xlOpenXMLWorkbook
ws.Copy Before:=wb.Worksheets(1)
wb.Close SaveChanges:=True
Next ws
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Edit1: If you want to make sure 2 file names never have the same name, you can use the Now function:
wb.SaveAs ThisWorkbook.Path & "\" & ws.Name & Format(Now, "yyyy-mm-dd_hh_mm_ss"), xlOpenXMLWorkbook
I can't replicate your problem on my system, but the following code minimizes the explicit creation and tracking of new Workbook objects, so it may be less error-prone across different environments:
Sub Make_Workbooks()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Copy 'Copies current sheet to new workbook
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ws.Name & "_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
ActiveWindow.Close
Next ws
End Sub
I've got this Macro working beautifully, but every now and again it will save the exported sheets into the last folder I was working in, and not the specific folder I want them in. How do I specify the folder they should go into?
Sub asdf()
Dim ws As Worksheet, newWb As Workbook
Application.ScreenUpdating = False
For Each ws In Sheets(Array("sheet1", "sheet2", "sheet3"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs ws.Name & ".csv", xlCSVWindows
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
End Sub
You need to specify the location you want it saved to in the code.
Try this.
.SaveAs FileName:="C:\OutputFilepath\" & ws.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False
Replace this line
.SaveAs ws.Name & ".csv", xlCSVWindows
With
.SaveAs "D:\MyFolder\" & ws.Name & ".csv", xlCSVWindows
Change the "D:\MyFolder\" to your desired path.
Add a string type var that contains the full path to the folder. In the following example, I'll use the temp directory.
Sub asdf()
Dim ws As Worksheet, newWb As Workbook, fp as string
fp = environ("TEMP") & Chr(92)
'could be something like
'fp = environ("USER") & "\desktop\"
Application.ScreenUpdating = False
For Each ws In Sheets(Array("sheet1", "sheet2", "sheet3"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs fp & ws.Name, xlCSVWindows 'add the path, let saveas add the extension
.Close savechanges:=False
End With
Next ws
Application.ScreenUpdating = True
End Sub
I created a macro that saves the value of an .xlsx file to a csv in a certain directory with the name of the csv = to the name of the Excel file which it was written from.
I wanted this macro to be available in any spreadsheet/workbook so I saved and added it as an add in.
I think I am having issues with ActiveWorkbook vs Thisworkbook.
The following code is the original that works as intended when not used as an add in:
Sub CSV()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
SaveToDirectory = "C:\SomeDirectory\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
End Sub
However if that code is used in the add in, the file saves with the name of the add in. So I changed the code and used ActiveWorkbook but it appears the value gets changed when it is time to save.
Sub CSV2()
On Error GoTo error_handler
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ActiveWorkbook.Name
CurrentFormat = ActiveWorkbook.FileFormat
SaveToDirectory = "C:\SomeDirectory\"
For Each WS In ActiveWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
error_handler:
MsgBox Err.Description
End Sub
I want to write my Excel file to csv. Save that CSV in the directory that is defined. With the name of the csv = the name of the file that the information is coming from. And to be able to do this in any workbook I open.
Try this code:
Sub CSV2()
On Error GoTo error_handler
Dim aWB As Workbook
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Set aWB = ActiveWorkbook
CurrentWorkbook = aWB.Name
CurrentFormat = aWB.FileFormat
SaveToDirectory = "C:\SomeDirectory\"
For Each WS In aWB.Worksheets
WS.Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & aWB.Name & "_" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
'ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
aWB.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
Exit Sub
error_handler:
MsgBox Err.Description
End Sub
I add ws.name after awb.name to prevent the same file name.
Based on some other stuff I found here, I have made the following script to do almost exactly what I want. It will export all but 4 specific sheets in an excel file to CSV files, append dates to them, and save them to dated folders. The only problem is it renames the sheets it exported in the original processing file. How can I rectify this?
Sub SaveLCPWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "C:\test\" & Format(Date - 1, "YYYYMM") & "\"
If Len(Dir(SaveToDirectory, vbDirectory)) = 0 Then
MkDir SaveToDirectory
End If
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Input" And WS.Name <> "Ref" And WS.Name <> "Total" And WS.Name <> "Affected Accounts" Then
WS.SaveAs SaveToDirectory & WS.Name & "_" & Format(Date - 1, "YYYYMMDD"), xlCSV
End If
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
Sub Tester()
Dim ws As Worksheet, wb As Workbook
For Each ws In ThisWorkbook.Worksheets
ws.Copy 'creates a new workbook
With ActiveWorkbook
.SaveAs "C:\temp\" & ws.Name & "_blah.csv", xlCSV
.Close False
End With
Next ws
End Sub