I am trying to use the below code to copy a range from a macro enabled workbook to a new excel file that then gets sent on to a company.
The code worked when saving the new file as a csv but I noticed it lost the formatting so I need to save it as an excel file.
I get a runtime error 1004 and message to say method save as of object workbook failed.
The only change I made was taking the .csv extension and changing to .xlsx.
Sub exportJuneCredit()
'
' export Macro
Range("A1:H500").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs Filename:= _
"file path Credits.xlsx" _
, FileFormat:=xlsx, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Try this: -
Sub exportJuneCredit()
Dim WkSht_Src As Worksheet
Dim WkBk_Dest As Workbook
Dim WkSht_Dest As Worksheet
Dim Rng As Range
Set WkSht_Src = ActiveSheet
Set Rng = WkSht_Src.Range("A1:H500")
Set WkBk_Dest = Application.Workbooks.Add
Set WkSht_Dest = WkBk_Dest.Worksheets(1)
Rng.Copy WkSht_Dest.Range("A1")
Set WkSht_Dest = Nothing
WkBk_Dest.SaveAs Filename:="file path Credits.xlsx", FileFormat:=XlFileFormat.xlWorkbookNormal, CreateBackup:=False
WkBk_Dest.Close 0
Set WkBk_Dest = Nothing
Set Rng = Nothing
Set WkSht_Src = Nothing
End Sub
The issue I believe you were having was that activeworkbook may not have been the workbook you wanted to save, to get around this I have explicitly declared items.
I also change the copy/paste to use just the copy feature.
Although would not let me open file after it was created. Changed the file format to: xlOpenXMLWorkbook as mentioned by YowE3K. – PA060 Jun 12 '17 at 11:42
The code given by Gary Evans is to save as the backward compatible .xls format. If you change the filename to have .xls as extension it will allow you to open.
If you want .xlsx file, then change file format to xlOpenXMLWorkbook as mentioned by YowE3K.
Related
I have an Excel-File in which the user can click on a button to save a version without formulas and only with values.
So far I use this VBA for it:
Sub Create_version_with_values_only()
Dim b As Worksheet
For Each b In Worksheets
b.Cells.Copy
b.Cells.Cells.PasteSpecial Paste:=xlPasteValues
Next b
Application.CutCopyMode = False
ActiveWorkbook.SaveCopyAs "G:\Folder\test.xlsm"
ThisWorkbook.Close SaveChanges:=False
End Sub
This VBA itself worsk fine.
However, the issue is that I have to close the file after the value-version of the file is created because the original version will not be available anymore.
Therefore, I am wondering if there is an alternative way to create the value-version of the file that makes it possible to go back to the original file afterwards.
Something like this:
Step 1) Change all formulas to values.
Step 2) Save the version with the values in the folder.
Step 3) Undo the value-replacements in original sheet without closing it.
Do you have any idea how to solve it?
There might be a more simple way to get there, but here's how you'd create a new workbook, transfer the values over and save.
Public Sub SaveValues()
Dim newWb As Workbook
Set newWb = Workbooks.Add 'create a new workbook for the values
Dim ws As Worksheet, newWs As Worksheet
For Each ws In ThisWorkbook.Worksheets
With newWb 'create worksheets and name them in new workbook
If ws.Index = 1 Then
Set newWs = .Worksheets(1)
Else
Set newWs = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
End If
newWs.Name = ws.Name
End With
With ws.UsedRange 'move values to new worksheet
newWs.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
Next
'save new workbook. If the current workbook is a .xlsb, change the .xlsm in the code below
newWb.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWb.Close
End Sub
Updated for alternatives below:
Alternative
An alternative is to use ThisWorkbook.Worksheets.Copy to copying all worksheets in one go. Unfortunately, to use this code, we have to use ActiveWorkbook to make a reference to the new workbook. (I hoped it might return a Workbook or Worksheets object)
Public Sub SaveValues2()
Dim newWB As Workbook
ThisWorkbook.Worksheets.Copy
Set newWB = ActiveWorkbook 'not great practice
Dim ws As Worksheet
For Each ws In newWB.Worksheets
With ws.UsedRange 'hardcode values
.Value = .Value
End With
Next
newWB.SaveAs Replace(ThisWorkbook.FullName, ".xlsm", "_hardcoded.xlsm"), xlOpenXMLWorkbookMacroEnabled
newWB.Close
End Sub
I would like to carry out the captioned task with the following codes modified from extendoffice.com (thank you).
Sub export_data_to_CSV()
Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
Dim LR As Long
LR = Application.WorksheetFunction.CountA(Worksheets("MAIN").Range("A1:A50001"))
Set WorkRng = Application.Selection
Set WorkRng = Worksheets("MAIN").Range("A2:J" & LR)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")
xFileString = Application.GetSaveAsFilename("", filefilter:="Comma Separated Text (*.CSV), *.CSV")
Application.ActiveWorkbook.SaveAs Filename:=xFileString, FileFormat:=xlCSV, CreateBackup:=False
End Sub
The code works fine, however, it saves all formulas and even my button to the target file. What should I do to the code if I only want to save values to the target CSV file?
CSV files can't have formulas or buttons by definition. I think you're just seeing them in the currently open Excel instance, but if you were to open the newly saved CSV file, they would not be present.
To address your follow-up question:
If I want to close the target file instantly with the code, what lines should I add?
ActiveWorkbook.Close SaveChanges:=False
Here is some demo code. It:
copies Sheet1 to a new workbook
clears all formula cells in the clone (copied) worksheet
saves the clone as .csv
closes the clone workbook
Sub KopyKat()
'
Sheets("Sheet1").Select 'move to sheet
Sheets("Sheet1").Copy 'copy sheet to new workbook
ActiveSheet.Cells.SpecialCells(-4123).Clear 'get rid of formulas
'then save as .csv
ActiveWorkbook.SaveAs Filename:="C:\Users\garys\Desktop\bk.csv", FileFormat _
:=xlCSVUTF8, CreateBackup:=False
ActiveWorkbook.Close 'close the new workbook
' the original workbook is now active again
End Sub
I have a workbook with 6 sheets.
I want to save the values (not formulas) of the sheets 1 and 2 in 2 external files.
Tried this:
Worksheets("Sheet1").Copy
With ActiveWorkbook
.SaveAs Filename:="D:\sheet1.xls", FileFormat:=56, CreateBackup:=False
End With
Worksheets("Sheet2").Copy
With ActiveWorkbook
.SaveAs Filename:="D:\sheet2.xls", FileFormat:=56, CreateBackup:=False
End With
It Works. But:
It's saving the formulas, not its values.
If file exists, prompt a message asking if want to override
You would need to convert the formulas into values on your own. Do something like the following:
ThisWorkbook.Worksheets("Sheet1").Copy 'create a copy in a new workbook
Dim wb As Workbook
Set wb = ActiveWorkbook 'get the new workbook
'change formulas into values
wb.Worksheets(1).UsedRange.Value = wb.Worksheets(1).UsedRange.Value
'save
wb.SaveAs Filename:="D:\sheet1.xls", FileFormat:=56, CreateBackup:=False
'close it
wb.Close SaveChanges:=False
If you want to get rid of the overwriting question, check if the file D:\sheet1.xls alrady exists and kill it before you save it. I don't explain that in detail because there are already one million tutorials for that.
Improvement
Use a procedure to re-use your code:
Public Sub ExportWorksheet(ByVal SheetName As String, ByVal ExportToFile As String)
ThisWorkbook.Worksheets(SheetName).Copy
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.Worksheets(1).UsedRange.Value = wb.Worksheets(1).UsedRange.Value
If Dir(ExportToFile) <> vbNullString Then Kill ExportToFile
wb.SaveAs Filename:=ExportToFile, FileFormat:=56, CreateBackup:=False
wb.Close SaveChanges:=False
End Sub
Sub TestIt()
ExportWorksheet SheetName:="Sheet1" ExportToFile:="D:\sheet1.xls"
ExportWorksheet SheetName:="Sheet2" ExportToFile:="D:\sheet2.xls"
End Sub
Note whenever you feel you would have to copy a code, split it apart into a seperate procedure to avoid redundancy.
A small example which may help: Option Explicit
Sub test()
Dim wsSou As Worksheet, wsDes As Worksheet
With ThisWorkbook
Set wsSou = .Worksheets("Sheet1")
Set wsDes = .Worksheets("Sheet2")
'Copy Paste - ONLY Values
wsSou.UsedRange.Copy
wsDes.Range("A1").PasteSpecial xlPasteValues
'Copy Paste - Values and Formattings
wsSou.UsedRange.Copy wsDes.Range("A1")
End With
End Sub
Related: Save each sheet in a workbook to separate CSV files
I’ve inherited some code that I’m trying to update. The intention is to take a particular range from each of certain (macro-generated) sheets and save them as distinct CSV files. Here’s the existing code, somewhat simplified & with error checking removed:
' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
.Range("J3:J322").Select
.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
End If
End With
Next CurrentSheet
End Sub
The line .Range("J3:J322").Select is a noop in this context, but how can I achieve what this was trying to do: save only the range J3:J322 to this new CSV file?
I've augmented your code and added comments. This code creates a temporary workbook to copy/paste your selection and save it. The temporary workbook is then closed. Note that this code will overwrite existing files without prompts. If you wish to see prompts, then remove the Application.DisplayAlerts lines before and after the loop.
Sub Extract_CSV()
Dim wb As Workbook
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
'Suppress Alerts so the user isn't prompted to Save or Replace the file
Application.DisplayAlerts = False
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
'Select the range and copy it to the clipboard
.Range("J3:J322").Select
Selection.Copy
'Create a temporary workbook and paste the selection into it
Set wb = Application.Workbooks.Add
wb.Worksheets(1).Paste
'Save the temporary workbook with the name of the the sheet as a CSV
wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
'Close the workbook
wb.Close
End If
End With
'Restore alerts
Application.DisplayAlerts = True
Next CurrentSheet
End Sub
You may copy the target range, paste it in a new worksheet (you may need to paste as values, and paste number format as well), and then save that worksheet.
The code below embodies the idea. Lines commented with '* are added/modified as compared to your code. A few things to bear in mind:
By pasting values, you prevent the (unlikely) case of having cells with functions whose evaluated value changes upon pasting in the newly created workbook.
Using rng instead of selecting the Range is the recommended practice. If you do not have a lot of these operations, you would likely not notice the (minor) time saving.
Disabling DisplayAlerts eliminates alerts during macro execution (please see this to find out if you would like to make adjustments).
' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
Dim CurrentSheet As Integer
For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(CurrentSheet).Activate
Application.DisplayAlerts = False '*
With ActiveWorkbook.Worksheets(CurrentSheet)
If (.Name <> "Table") Then
'.Range("J3:J322").Select
Dim rng As Range '*
Set rng = .Range("J3:J322") '*
rng.Copy '*
Dim wb As Workbook '*
Set wb = Application.Workbooks.Add '*
wb.Worksheets(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False '*
wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True '*
wb.Close '*
End If
End With
Application.DisplayAlerts = True '*
Next CurrentSheet
End Sub
My function is as follows:
Sub saveCSV()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"c:\temp\file.csv", FileFormat:=xlCSV _
, CreateBackup:=False
End Sub
I'm trying to export the active worksheet to CSV. When I run the code in the title, Book1.xlsm changes to file.csv and Sheet1 changes to file. The export works fine. How can I do the export without these unwanted side effects?
That's always how SaveAs has worked. The only way to get around this is to copy the worksheet and do a SaveAs on the copy, then close it.
EDIT: I should add an example as it's not that difficult to do. Here's a quick example that copies the ActiveSheet to a new workbook.
Dim wbk As Workbook
Set wbk = Workbooks.Add
ActiveSheet.Copy wbk.Sheets(1) ' Copy activesheet before the first sheet of wbk
wbk.SaveAs ....
wbk.Close
A complicated workbook may get issues with links and macros, but in ordinary scenarios this is safe.
EDIT 2: I'm aware of what you're trying to do, as your other question was about trying to trigger an export on every change to the sheet. This copy sheet approach presented here is likely to be highly disruptive.
My suggestion is to write a CSV file by hand to minimise GUI interruption. The sheet is likely to become unusable if the saves are occurring at high frequency. I wouldn't lay the blame for this at the door of Excel, it simply wasn't built for rapid saves done behind the scenes.
Here's a little routine that does what you want by operating on a copy of the original ... copy made via file scripting object. Hardcoded to operate on "ThisWorkbook" as opposed to active workbook & presumes ".xlsm" suffix - could tweak this to do the job I think:
Public Sub SaveCopyAsCsv()
Dim sThisFile As String: sThisFile = ThisWorkbook.FullName
Dim sCsvFile As String: sTempFile = Replace(sThisFile, ".xlsm", "_TEMP.xlsm")
ThisWorkbook.Save ' save the current workbook
' copy the saved workbook ABC.xlsm to TEMP_ABC.xlsm
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes prev temp file if it exists
On Error GoTo 0
Call fso.CopyFile(sThisFile, sTempFile, True)
' open the temp file & save as CSV
Dim wbTemp As Workbook
Set wbTemp = Workbooks.Open(sTempFile) ' open the temp file in excel
' your prev code to save as CSV
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="c:\temp\file.csv", FileFormat:=xlCSV, CreateBackup:=False
wbTemp.Close ' close the temp file now that the copy has been made
Application.DisplayAlerts = True
' delete the temp file (if you want)
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes the temp file
On Error GoTo 0
End Sub