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
Related
I have the following code that loops through files and saves them as new files.
Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wbTarget As Workbook
Dim wsTarget As Worksheet
Dim wsHide1 As Worksheet 'Declare Sheets to hide'
Dim wsHide2 As Worksheet
Dim wsHide3 As Worksheet
Dim wsHide4 As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row
'Master workbook row that needs to be updated with source data'
rowTarget = 9
'Source files location'
Const FOLDER_PATH = "T:\SAMPLE DATA\1 - Split Raw Files\"
'loop through the Excel files in the folder'
sFile = Dir(FOLDER_PATH & "*.xls*")
'open template'
Const MASTER = "T:\SAMPLE DATA\ V7 Template\Tool Template V7.xlsm"
Set wbTarget = Workbooks.Open(MASTER)
Set wsTarget = Sheets("DATABASE") 'Target sheet of where data from source needs to be inserted'
'Sheets to hide'
Set wsHide1 = Sheets("Office Use Only1")
Set wsHide2 = Sheets("Office Use Only2")
Set wsHide3 = Sheets("Office Use Only3")
Set wsHide4 = Sheets("Office Use Only4")
wsTarget.Visible = xlVeryHidden
wsHide1.Visible = xlVeryHidden
wsHide2.Visible = xlVeryHidden
wsHide3.Visible = xlVeryHidden
wsHide4.Visible = xlVeryHidden
Do While sFile <> ""
' read source
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile) ' update links, readonly
Set wsSource = wbSource.Sheets(1)
' create target'
'wsTarget.Name = Replace(sFile, ".xlsx", "")'
wsTarget.Name = "DATABASE"
wsTarget.Unprotect "Password"
wsTarget.Range("A" & rowTarget).Resize(1, 364) = wsSource.Range("A2:MZ2").Value
wbTarget.SaveAs "T:\SAMPLE DATA\2 -Final Files\" & sFile & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
wsTarget.Protect "Password"
Application.DisplayAlerts = False 'Remove pop up messages'
wbSource.Close False
sFile = Dir
wsTarget.Visible = xlVeryHidden
wsHide1.Visible = xlVeryHidden
wsHide2.Visible = xlVeryHidden
wsHide3.Visible = xlVeryHidden
wsHide4.Visible = xlVeryHidden
Loop
wbTarget.Close False
End Sub
However the files keep saving as xlsx files in the loop and not macro enabled files with xlsm format. I also see that the files are saved with this type "Microsoft Excel 97-2003 Worksheet".. This format is supposed to be Microsoft macro enabled workbook as i use FileFormat:=xlOpenXMLWorkbookMacroEnabled.
Also how do i remove this pop up when i try to open the generated files above ? I tried to use Application.DisplayAlerts = False. However this doesn't seem to work.
Save File in Another Format
When changing the format of a file, you have to change both, its extension and the FileFormat parameter.
Also, note that column MZ is column 364, not 347.
Dim NewName As String
NewName = "T:\SAMPLE DATA\2 - Files\" & "test- " & sFile
NewName = Left(NewName, InStrRev(NewName, ".")) & "xlsm"
Application.DisplayAlerts = False 'Remove pop up messages'
wbTarget.SaveAs NewName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
wsTarget.Protect "Password"
wbSource.Close False
Application.DisplayAlerts = True
i am trying to export a sheet from my Excel file as a csv.
I am getting the error
Method SaveAs of Object Workbook Failed`
on my SaveAs line.
I notice as this code creates a new workbook, it has several blank default sheet tabs, would this be causing the issue?
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("Load check data") 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
Path = ThisWorkbook.Sheets("Input").Range("B15") & "estload_" & ThisWorkbook.Sheets("Input").Range("F1") & ".csv"
Debug.Print Path
wbkExport.SaveAs Filename:=Path, FileFormat:=xlCSV, CreateBackup:=True
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
Edit to exclude WbkExport variable, replace with ThisWorkbook and ActiveWorkbook.
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Dim Path As String
Set shtToExport = ThisWorkbook.Worksheets("Load check data") 'Sheet to export as CSV
'Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
Path = ThisWorkbook.Sheets("Input").Range("B15") & "estload_" & ThisWorkbook.Sheets("Input").Range("F1") & ".csv"
Debug.Print Path
ActiveSheet.SaveAs Filename:=Path, FileFormat:=xlCSV, CreateBackup:=True
Application.DisplayAlerts = True
'wbkExport.Close SaveChanges:=False
The previous comments are correct. A simple procedure would be:
Public Sub ExportWorksheetAndSaveAsCSV()
'Simple copy of sheet content as csv file
Dim NameSheet As String
Dim PathNameCsv As Variant
'Change names & Output Path
NameSheet = "MySheet"
PathNameCsv = "D:\Documents\MyCsv"
Set shtToExport = ThisWorkbook.Worksheets(NameSheet) 'Sheet to export as CSV
Application.DisplayAlerts = False 'Possibly overwrite without asking
shtToExport.SaveAs Filename:=PathNameCsv, FileFormat:=xlCSV, CreateBackup:=True
Application.DisplayAlerts = True
'When saving the sheet as csv, _
'by default its name is changed to the name of the csv.
'Here you restore your name
With shtToExport
.Name = NameSheet '
End With
End Sub
I have a macro that works in any Excel workbook but doesn't work once I place it in my PERSONAL.XLSB file. My goal is to take the tabs from all of the files in a folder on my desktop and copy them into the active file. I know the issue is that I am using This.Workbook as the location reference for the copied tabs but I don't know how else to reference the workbook I am trying to copy the tabs into. I don't want to reference a filepath for where to copy the tabs since this will be used by multiple people in multiple files. Any thoughts would be greatly appreciated.
Sub CombineWorkbooks()
Dim Path As Variant
Path = GetFolder(1) & "\"
Dim FileName As String
FileName = Dir(Path & "*.xl??")
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open Path & FileName
For Each ws In ActiveWorkbook.Sheets
ws.Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Next ws
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End Sub
If you define the file to a variable or activeworkbook it should work.
UPDATED as I think I slightly misunderstood the overall objective of macro but the concept is still the same. Let me know if this doesn't work.
Sub CombineWorkbooks()
Dim Path As Variant
Path = GetFolder(1) & "\"
Dim FileName As String
FileName = Dir(Path & "*.xl??")
Dim ws As Worksheet, wkBkToCopyTo As Workbook
Set wkBkToCopyTo = ActiveWorkbook 'assuming that you run this with the destination open.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open Path & FileName
For Each ws In ActiveWorkbook.Sheets
ws.Copy after:=wkBkToCopyTo.Worksheets(wkBkToCopyTo.Worksheets.Count)
Next ws
Workbooks(FileName).Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
End Sub
You could also try to find it based on its name:
'you could also use a loop to find it
For Each wkBkToCopyTo In Application.Workbooks
If InStr(1, wkBkToCopyTo.Name, "someNameof the workbook", vbTextCompare) > 0 Then
Exit For
End If
Next wkBkToCopyTo
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
I'm new to VBA and stuck on an issue. I'm trying to copy a table to a .csv file and I want the end result to contain the original .xlsm name & the table name and date/time. I've successfully pieced together code to export the table to .csv with the table name and date/time but I'm struggling to get the file mane in there. I get the following error "Method 'SaveAs' of object'_Workbook' failed"
Below is what I have, any help would be great!
Sub ExportTableBanquetEarnings()
Application.ScreenUpdating = False
Sheets("BanquetEarnings").Visible = True
Sheets("BanquetEarnings").Select
Dim wb As Workbook, wbNew As Workbook
Dim ws As Worksheet, wsNew As Worksheet
Dim wbNewName As String
Dim wbCurrent As String
wbCurrent = ThisWorkbook.FullName
Set wb = ThisWorkbook
Set ws = ActiveSheet
Set wbNew = Workbooks.Add
With wbNew
Set wsNew = wbNew.Sheets("Sheet1")
wbNewName = ws.ListObjects(1).Name
ws.ListObjects(1).Range.Copy
wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll
.SaveAs Filename:="F:\admin\Report Databases\BanquetTipouts" & "\" &
wbCurrent & wbNewName & Format(Now, "yyyymmdd_hhmm") & ".csv", _
FileFormat:=xlCSVMSDOS, CreateBackup:=False
End With
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
ActiveWorkbook.RefreshAll
Sheets("BanquetEarnings").Visible = False
Sheets("Blank Cost Sheet").Select
Workbooks.Open "F:\Function Agreements\Cost Sheets M\Payroll Report -
V2.xlsm"
End Sub
The below code will show the path of that Workbook
wbCurrent = ThisWorkbook.FullName
I think what you meant to use is...
wbCurrent = ThisWorkbook.Name
Also, I think another issue might be the Now method, it should be as Now()