Hello so I used the below coding to try to "save as" the active worksheet to the current same folder, however the problem I am facing is that the file name does not appear as E6 however it is just a blank.
Also, is there a faster way to actually just omit the save as dialog and just save as a new workbook in the same folder as the macro? With the same file type as xls. Thank you.
Sub Button1_Click()
Dim varResult As Variant
Dim dirPath, fileName As String
dirPath = Application.ActiveWorkbook.Path
fileName = ActiveSheet.Range("E6").Value 'ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xls), *.xls", Title:="Save As", _
InitialFileName:=dirPath & "\" & fileName)
ActiveWorkbook.SaveCopyAs fileName:=varResult
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
To directly save without using the dialog, try the next code, please:
Sub testSaveAs()
Dim wb As Workbook
Set wb = ActiveWorkbook 'Use here your workbook
wb.SaveAs fileName:=ThisWorkbook.path & "\" & ActiveSheet.Range("E6").value & ".xls"
End Sub
Related
I am trying to export Excel files to another folder as PDFs. The macro is stored in a separate .xlsm that I have open, and I directed the code to the folder with all the files that need to be PDFs.
The code only exports the first PDF in the folder. The error I got was that it could not operate in Page Break Mode, so I set it to normal mode for running the code but I still get the error.
Beyond that, it is reading the workbook that I have the macro stored in as a second active window. I ran the code to export to PDF on a single PDF and it worked as expected.
Option Explicit
Sub PPG_PDF_File()
'Below is used to make code run faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim strExtension As String
Dim wsA As Worksheet
Dim strName As String
Dim strName1 As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Const strPath1 As String = "C:\Users\steve.argen\Documents\PPG\GW Sampling March 2020\PPG Balogna NUMBER 2\Final excel sheets\Test Macro Folder DNAPL Wells\"
ChDir strPath1
strExtension = Dir(strPath1 & "*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath1 & strExtension)
With wkbSource.Sheets("LowFlow GW front")
ActiveWindow.View = xlNormalView
On Error GoTo errHandler
Set wkbSource = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wkbSource.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("A1").Value _
& " - " & wsA.Range("A2").Value _
& " - " & wsA.Range("A3").Value
'create default name for savng file
strFile = wkbSource.Name & ".pdf"
strFile = Replace(strFile, ".xlsx", "")
strPathFile = "C:\Users\steve.argen\Documents\PPG\GW Sampling March 2020\PPG Balogna NUMBER 2\Final excel sheets\Final PDF\" & strFile
'export to PDF in current folder
wkbSource.Sheets(Array("LowFlow GW Front", "LowFlow GW Back")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
Application.CutCopyMode = False 'If you ever need to copy a large amount of info, this will hide any warnings
ActiveWindow.View = xlPageBreakPreview
End With
wkbSource.Close savechanges:=False
strExtension = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
This code
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
it should be at the end of the routine and not in the middle of the loop.
Hi i have encountered an error when i try to execute this vba. Basically i am trying to save the active worksheet with the code below.
Sub Button1_Click()
Dim varResult As Variant
Dim dirPath, fileName As String
dirPath = Application.ActiveWorkbook.Path
fileName = ActiveSheet.Range("J5").Value 'ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
varResult = Application.GetSaveAsFilename(FileFilter:= _
"Microsoft Excel 97-2003 Worksheet (.xls) (*.xls), *.xls", Title:="Save As", _
InitialFileName:=dirPath & "\" & fileName)
ActiveWorkbook.Worksheets("CBC").SaveCopyAs fileName:=varResult
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I cannot write comment (too low reputation) so as an answer.
I think that you are trying to save a worksheet, but SaveCopyAs can be used only with Workbook object.
Try this: Macro to save only the active worksheet
I was hoping to save my new csv file sheet1 as "CSV123" but somehow the sheet name is always changed to filename after I save and close the file.
I am not sure why the .Sheets(1).Name = "CSV123" is registered when I use F8 to check but does not register after I close the workbook.
Sub Save_as_CSV()
Dim Newbook As Workbook
Dim filename As String
Dim answer As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
answer = InputBox("Please enter the file name for save", "CSV File Name")
If answer <> "" Then
filename = Application.ThisWorkbook.Path & "\" & answer & ".csv"
Set Newbook = Workbooks.Add
shcsv.Copy before:=Newbook.Sheets(1)
With Newbook
.Sheets(1).Rows("1:3").Delete
.SaveAs filename:=filename, FileFormat:=Excel.xlCSV
.Sheets(1).Name = "CSV123"
.Save
.Close
End With
Else
Exit Sub
End If
MsgBox "The CSV is exported to the same directory as this file."
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I am trying to create a copy of my workbook when saving but when I create that copy, lock all cells so they can't be changed.
Here is what I have...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FName As String
Dim FPath As String
Dim NewBook As Workbook
FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"
Set NewBook = Workbooks.Add
Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs Filename:=FPath & FName, FileFormat:=51
ActiveWorkbook.Close
Application.DisplayAlerts = True
'NewBook.SaveAs Filename:=FPath & FName, FileFormat:=51
Application.DisplayAlerts = False
NewBook.Close
Application.DisplayAlerts = True
End Sub
Any help would be much appreciated.
Many thanks in advance
In your case, you can use usedrange.locked to lock the entire used range of the new workbook. However this does not prevent editing until the workbook is protected, so best to do that as well with worksheet.protect. Full code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FName As String
Dim FPath As String
ThisWorkbook.Activate
FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"
Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
With ActiveWorkbook
.Sheets(1).UsedRange.Locked = True
.Sheets(1).Protect ""
.SaveAs Filename:=FPath & FName, FileFormat:=51
.Close
End With
Application.DisplayAlerts = True
End Sub
Note, usedrange is normally not the best practise to cover the entire range as it sometimes goes too large. However in your case you need to make sure all cells in the sheet are covered. Since all cells are protected by default when unchanged, usedrange will do the trick here nicely for the rest.
Edit, I glossed over most of the code as only the protect was relevant to the question. However as per comments, this leads to an issue. What happens is that you create a new workbook, and then copy the workbook with your code. This automatically creates a new workbook as well. This is the one which is saved, and newbook is closed without anything changed to it. I removed this part of the code. ActiveWorkbook after you copy should be the one containing your copied data, so I made this the one being locked and saved.
I have the following code to save my worksheets as csv files to the folder the workbook is saved in. How do I modify this to bring up a 'save as' dialog box to let me choose where I'd like to save?
To be more specific, I want to modify the code to be able to specify just the path to which all the files can be saved. I'm not looking to get a save as for each worksheet.
Sub SaveOnlyCSVsThatAreNeeded()
Dim ws As Worksheet, newWb As Workbook
Application.ScreenUpdating = False
For Each ws In Sheets(Array("01 - Currencies", ..."14 - User Defined Fields"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
End Sub
I have replaced the whole thing with a folder picker in an effort to simplify it. Posted updated code. Now I get Error code 9 - Subscript out of range.
Sub SaveOnlyCSVsThatAreNeeded()
Dim ws As Worksheet, newWb As Workbook
Dim pathh As Variant
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then
FolderName = .SelectedItems(1)
End If
End With
pathh = FolderName
Application.ScreenUpdating = False
For Each ws In Sheets(Array("01 - Currencies", "02 - .....14 - User Defined Fields"))
ws.Copy
Set newWb = ActiveWorkbook
With newWb
.SaveAs pathh.path & "\" & ws.Name, xlCSV
.Close (False)
End With
Next ws
Application.ScreenUpdating = True
End Sub
Use the following code to show the Save As dialog screen:
pathh = Application.GetSaveAsFilename( _
FileFilter:="CSV Files (*.csv), *.csv", _
Title:="Save all spreadsheets", _
InitialFileName:=filenamestring)
Cheers
The command to propt the save as dialog in VB is:
Application.GetSaveAsFilename