I found this question asked before, but it was never answered. I have some VBA code that formats different files and outputs them onto an Excel spreadsheet, and then saves copies to two different directories. However, the trouble I'm having is that it leaves an empty workbook open and I don't know how to close it. I have tried Workbooks.Close, and Application.Quit but neither worked. Any help would be greatly appreciated. Here is the part of my code that I'm referring to:
sSaveAsFilePath = "\\Filesrv02\test\remit" + ".csv"
sSaveAsFilePath2 = "\\Filesrv02\backup\remit" + Format(Date, "mmddyy") + ".csv"
Application.DisplayAlerts = False
ChDir "\\Filesrv02\test"
ActiveWorkbook.SaveAs FileName:=sSaveAsFilePath, _
FileFormat:=xlCSV, CreateBackup:=False
'ActiveWorkbook.Close False
ChDir "\\Filesrv02\Backup"
ActiveWorkbook.SaveAs FileName:=sSaveAsFilePath2, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close True
Application.DisplayAlerts = False
MsgBox ("done")
End Sub
Since you are only copying a sheet out of your workbook to save in different locations, you can just copy that sheet out of the workbook and save it to another location. This will leave your original workbook intact, and will not make a mysterious blank workbooks. Also, note how I qualified all the workbooks and worksheets with variables.
sSaveAsFilePath = "\\Filesrv02\test\remit" + ".csv"
sSaveAsFilePath2 = "\\Filesrv02\backup\remit" + Format(Date, "mmddyy") + ".csv"
Application.DisplayAlerts = False
Dim wb As Workbook, wbC As Workbook, ws As Worksheet
Set wb = ThisWorkbook
Set ws = ws.Sheets("mySheet") 'change name as needed
'create and save test version
ws.Copy
Set wbC = ActiveWorkbook
With wbC
.SaveAs Filename:=sSaveAsFilePath, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
'create and save backup version
ws.Copy
Set wbC = ActiveWorkbook
With wbC
.SaveAs Filename:=sSaveAsFilePath2, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
Application.DisplayAlerts = False
MsgBox ("done")
Create a new workbook before save
Application.Workbooks.Add
ActiveWorkbook.SaveAs FileName:=sSaveAsFilePath, _
FileFormat:=xlCSV, CreateBackup:=False
ActiveWorkbook.Close False
Related
I could have sworn that this was working before - but for some reason, this doesn't appear to be working anymore. I'm trying to take the active worksheet (also, this may not be very pretty or clean, but I am still really new to VBA), copy it to a new worksheet, in the new worksheet I want to open the Excel save as dialog, and when the worksheet is saved (in CSV) format, I want the workbook to close (or even if it doesn't close) at least return the user to the original workbook and end the sub
Sub saveExportAs()
Application.CutCopyMode = False
Sheets("load").Select
ActiveWorkbook.Activate
Sheets("load").Copy
Dim varResult As Variant
Dim ActBook As Workbook
'display the save as dialog
varResult = Application.GetSaveAsFilename(InitialFileName:="\\network\folder\upload_" & Format(Date, "yyyy-mm-dd") & ".csv", FileFilter:= _
"Comma Delimited / Upload Files (*.csv),*.csv", Title:="Save Upload File")
'check to make sure the user didn't cancel
If varResult <> False Then
ActiveWorkbook.saveAs Filename:=varResult, _
FileFormat:=xlCSV
Exit Sub
End If
End Sub
you can use the sheets defined as workbook/worksheet to avoid issues... may be like this :
Sub saveExportAs()
Dim wb1, wb2 As Workbook
Dim ws As Worksheet
Dim varResult As Variant
Set wb1 = ThisWorkbook
Set ws = ThisWorkbook.Worksheets("load")
ws.Copy
Set wb2 = ActiveWorkbook
varResult = Application.GetSaveAsFilename(InitialFileName:="\\network\folder\upload_" & Format(Date, "yyyy-mm-dd") & ".csv", FileFilter:= _
"Comma Delimited / Upload Files (*.csv),*.csv", Title:="Save Upload File")
If varResult <> False Then
wb2.SaveAs Filename:=varResult, FileFormat:=xlCSV
wb2.Close Savechanges:=True
Exit Sub
End If
wb1.Activate
End Sub
Try this...
Sub exportAsCSV()
Dim wb As Workbook
Set wb = ActiveWorkbook
SaveCopyAsCSV ("Sheet1") ' replace Sheet1 with whatever sheet name you need
wb.Activate
End Sub
Private Function SaveCopyAsCSV(SourceSheet As String)
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SourceSheet).copy
ActiveWorkbook.SaveAs fileName:=SourceSheet, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Function
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'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 am using this code to copy every sheet in a workbook to a new one and it works fine but it reverses the order of the sheets, would there be anyway to keep it from doing this?
Sub copy()
'copies all the sheets of the open workbook to a new one
Dim thisWb As Workbook, wbTemp As Workbook
Dim ws As Worksheet
On Error GoTo Whoa
Application.DisplayAlerts = False
Set thisWb = ThisWorkbook
Set wbTemp = Workbooks.Add
On Error Resume Next
For Each ws In wbTemp.Worksheets
ws.Delete
Next
On Error GoTo 0
For Each ws In thisWb.Sheets
ws.copy After:=wbTemp.Sheets(1)
Next
wbTemp.Sheets(1).Delete
'save vba code here
Application.Dialogs(xlDialogSaveAs).Show Range("CA1").Text & "- (Submittal) " & Format(Date, "mm-dd-yy") & "_" & Format(Time, "hhmm") & ".xlsx"
LetsContinue:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
I'm copying all the sheets so i can save it as a different file extension and this was the only way i found that worked.
Workbook before it copies
Workbook after it copies
From Scott Craner's comment, which OP replied to indicating it worked:
Change
ws.copy After:=wbTemp.Sheets(1)
to:
ws.copy After:=wbTemp.Sheets(wbTemp.Worksheets.Count)
If you only want to change the file format
(I'm copying all the sheets so i can save it as a different file extension and this was the only way i found that worked.)
Then you can try this code:
Sub Test()
fn = Range("CA1").Text & "- (Submittal) " & Format(Now, "mm-dd-yy_hhmm")
fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fn, fileFilter:="Excel Workbook (*.xlsx), *.xlsx")
If fileSaveName <> False Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs fileSaveName, xlOpenXMLWorkbook
Application.DisplayAlerts = True
End If
End Sub
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