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
Related
I am struggling to convert my XLSM to XLSX File..it was before transformation to PDF, and I tried to change a bit but didnt succeed.
I wanna to have the same name as the workbook has, but just in XLSX format.
Sub xlsmtoxlsx()
Dim PathFile As String
Dim PathArray() As String
Dim PathPDF As String
'Get file path
PathFile = Application.ThisWorkbook.FullName
'Split file path in path and file ending
PathArray() = Split(PathFile, ".")
'Creat file path with ".pdf" ending
PathPDF = PathArray(0) & ".xlsx"
'PDF File is saved in directory of workbook
ActiveSheet.ExportAsFixedFormat Type:=xlTypeXlsx, Filename:= _
PathPDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
'Closes Workbook after generating PDF
ActiveWorkbook.Saved = True
Application.Quit
Backup as XLSX
Option Explicit
Sub BackupAsXLSX()
' Create a reference to the source workbook.
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
' Determine the destination file path ('FullName').
Dim sFilePath As String: sFilePath = swb.FullName
Dim DotPosition As Long: DotPosition = InStrRev(sFilePath, ".")
Dim dFilePath As String: dFilePath = Left(sFilePath, DotPosition) & "xlsx"
Application.ScreenUpdating = False
' Copy all sheets to a new (destination) workbook.
swb.Sheets.Copy
Dim dwb As Workbook: Set dwb = ActiveWorkbook
' Save and close the destination workbook.
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
dwb.Close SaveChanges:=False
Application.ScreenUpdating = True
' Inform.
MsgBox "XLSX backup created.", vbInformation
' Note that the source workbook hasn't been modified in any way.
End Sub
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
Is it possible to copy a worksheet from a workbook without opening it and pasting it to the opened workbook with no default file location ? The worksheet that I am trying to copy from contains a total of 30 worksheets. I have tried using file dialog to open but sometimes it would hang the excel. Is there any way that won't hang the excel and do what I want? Thank you in advance.
Dim FileToOpen As String
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a Excel File to Open", _
FileFilter:="Excel Files *.(*.xlsx),xlsx")
If VarType(FileToOpen) = vbBoolean Then
MsgBox "No file selected", vbExclamation, "Sorry!"
Exit Sub
End If
Debug.Assert VarType(FileToOpen) = vbString
With Application.Workbooks.Open(FileToOpen)
.Worksheets(22).UsedRange.Copy ThisWorkbook.Worksheets(2).range("A1")
.Close
End With
Private Sub test()
Dim app As New Excel.Application
Dim fileName As String, copyFrom As Workbook
app.Visible = False
fileName = app.GetOpenFilename()
Set copyFrom = app.Workbooks.Open(fileName)
MsgBox copyFrom.Sheets(1).Cells(1, 1)
End Sub
this should fit what you want to achieve
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
I've been looking on StackOverflow for a solution to this problem and I'm almost there but I can't seem to solve my last problem: saving only a specific worksheet to a new file. Basically, what I want to do is the following:
User clicks and "Archive Data" button
User is prompted to choose a filepath and "SaveAs" a new Excel workbook
Code will copy the range of data in the current worksheet
Code will paste that range to the new Excel workbook specified in the "SaveAs"
My problem is that it saves the whole workbook and I have no way of copying and pasting/saving the specific range in the desired worksheet. Please see the code for reference and let me know if you have any questions.
Sub ArchiveData()
Dim ThisFile As String
Dim NewFile As String
Dim ActBook As Workbook
Dim NewShtName As String
Dim NewFileType As String
NewShtName = "Archived Data on " & Format(Date, "MM.DD.YYYY")
'Copy
ThisFile = ThisWorkbook.FullName
NewFileType = "Excel 1997-2003 (*.xls), *.xls,Excel 2007-2013 (*.xlsx), .*xlsx,Excel 2007-2013 Macro-Enabled (*.xlsm), .*xlsm)"
NewFile = Application.GetSaveAsFilename(InitialFileName:=NewFileName, FileFilter:=NewFileType)
'Paste
If NewFile = "False" Then
MsgBox ("File unable to be saved")
Exit Sub
Else
ActiveWorkbook.Sheets(2).SaveAs Filename:=NewFile, FileFormat:=51 'Need to save as .xls and/or .xlsx
ThisWorkbook.Sheets(2).range("A4:S65536").Copy
ActiveWorkbook.Sheets(1).range("A4:S65536").PasteSpecial (xlPasteValues)
ActiveWorkbook.Sheets(1).Name = NewShtName
'Close new book
Set ActBook = ActiveWorkbook
Workbooks.Open ThisFile
ActBook.Close
End If
MsgBox ("File saved")
End Sub
You would use something like this to copy the sheet to a new workbook, which becomes active, then save it using the path specified by the user:
ActiveWorkbook.Sheets(2).Copy
Activeworkbook.SaveAs Filename:=NewFile, FileFormat:=51
If you don't want the whole sheet, you can use:
Dim wb as Workbook
Set wb = Workbooks.Add(xlwbatworksheet)
ThisWorkbook.Sheets(2).range("A4:S65536").Copy
wb.Sheets(1).range("A4").PasteSpecial xlPasteValues
wb.saveas Filename:=NewFile, FileFormat:=51