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
Related
I have a code which is doing following:
Prompt to choose external workbook
Copying all the data from that wb
Pasting exactly 1:1 in main wb
Close and Save from .xlsm to .xlsx but with a name of my main wb
Sub CopySheetFromClosedWorkbook2()
'Prompt to choose your file in the chosen locatioon
Dim dialogBox As FileDialog
Dim FilePath As String
Set dialogBox = Application.FileDialog(msoFileDialogOpen)
Application.StatusBar = "Choose older PDS Form!"
dialogBox.AllowMultiSelect = False
dialogBox.Title = "Select a file"
If dialogBox.Show = -1 Then
FilePath = dialogBox.SelectedItems(1)
'If nothing selected then MsgBox
Else
MsgBox "No PDS Form selected!"
Exit Sub
End If
'Here are sheets defined which you are going to copy/paste (reference update) but to keep formatting.
''Sheets should be defined from right to left to have your sheets sorted from the beginning
Dim shNames As Variant: shNames = Array("CH_or_Recipe_8", "CH_or_Recipe_7", "CH_or_Recipe_6", "CH_or_Recipe_5", "CH_or_Recipe_4", _
"CH_or_Recipe_3", "CH_or_Recipe_2", "CH_or_Recipe_1", "Customer Details", "Instructions")
Dim tgt As Workbook: Set tgt = ThisWorkbook
Application.ScreenUpdating = False
Dim src As Workbook: Set src = Workbooks.Open(FilePath)
Dim ws As Worksheet, rng As Range, i As Long
For Each ws In src.Sheets
If ws.Name Like "*[1-8]" Then
ws.Name = "CH_or_Recipe_" & Right(ws.Name, 1)
ElseIf ws.Name = "Customer_Details" Then
ws.Name = "Customer Details"
ElseIf ws.Name = "OIPT Plasmalab" Then
ws.Name = "CH_or_Recipe_1"
ElseIf ws.Name = "AMAT" Then
ws.Name = "CH_or_Recipe_2"
End If
Next
For i = 0 To UBound(shNames)
On Error Resume Next
Set ws = src.Sheets(shNames(i))
If Err.Number = 0 Then
tgt.Worksheets(shNames(i)).Cells.Clear
Set rng = ws.UsedRange
rng.Copy tgt.Worksheets(shNames(i)).Range(rng.Address)
End If
Next i
src.Close False
Application.ScreenUpdating = True
MsgBox "Copy&Paste successful!"
End Sub
Sub SaveNoMacro()
Dim fn As String
With ThisWorkbook
fn = Replace(.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
.SaveAs fn, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
End With
MsgBox "Saved as " & fn
End Sub
What I just need (if possible) is to save my wb in the same name as that external wb that I am taking data from and adding date/time at the end.
Example:
MainWB1.xlsm + ExternalWB1.xlsx >>> MainWB1.xlsx (This is now)
MainWB1.xlsm + ExternalWB1.xlsx >>> ExternalWB1_today().xlsx (This is what I wanna)
You have 2 separate methods:
CopySheetFromClosedWorkbook2
SaveNoMacro
The name of the source workbook is only available in the scope of the CopySheetFromClosedWorkbook2 because that's where you open and close it. So, you have 2 options:
Save the main workbook before exiting the scope of the CopySheetFromClosedWorkbook2 method i.e. while the name of the source book is available
Save the name of the source book somewhere (global variable, named range, registy, custom xml part etc.) or even return it as a result (Function instead of Sub) so that you can call the SaveNoMacro method at a later stage
Save before exiting the scope
Here are 2 ways to do this:
Place your save code before the src.Close False line so that you can use the src.Name property i.e. combine the 2 methods into one. Not sure if you want to do this
Pass the name as an argument to the second method. In CopySheetFromClosedWorkbook2 replace this:
src.Close False
with this:
SaveNoMacro src.Name
src.Close False
and update SaveNoMacro to:
Sub SaveNoMacro(ByVal newName As String)
Dim fn As String
With ThisWorkbook
fn = Replace(.FullName, .Name, Left(newName, InStrRev(newName, ".") - 1)) _
& Format$(Date, "_yyyy-mm-dd") & ".xlsx"
Application.DisplayAlerts = False
.SaveAs fn, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
End With
MsgBox "Saved as " & fn
End Sub
Save the name for later use
In case you don't want to run the 2 methods in a sequence then you can save the name for later use. Using a global variable is not a good idea as the state can be lost by the time you run the save method. Using a named range would work as long as you don't have your workbook protected i.e you can create a named range.
There are many options but the easiest to use is to write to registry using the built in SaveSetting option. Replace this:
src.Close False
with this:
SaveSetting "MyApp", "MySection", "NewBookName", src.Name
src.Close False
and update SaveNoMacro to:
Sub SaveNoMacro()
Dim fn As String: fn = GetSetting("MyApp", "MySection", "NewBookName")
If LenB(fn) = 0 Then
MsgBox "No name was saved", vbInformation, "Cancelled"
Exit Sub
Else
DeleteSetting "MyApp", "MySection", "NewBookName"
End If
With ThisWorkbook
fn = Replace(.FullName, .Name, Left(fn, InStrRev(fn, ".") - 1)) _
& Format$(Date, "_yyyy-mm-dd") & ".xlsx"
Application.DisplayAlerts = False
.SaveAs fn, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
End With
MsgBox "Saved as " & fn
End Sub
fn = Replace(.FullName, ".xlsm", ".xlsx")
fn = Replace(.FullName, ".xlsm", date & ".xlsx")
What I just need (if possible) is to save my wb in the same name as that external wb that I am taking data from and adding date/time at the end
You got the full path of your external wb in the variable FilePath so you can use that to save the workbook. You could save it like this (at the end of your sub CopySheetFromClosedWorkbook2):
Dim SaveName As String
SaveName = src.Path & "\" & Replace(Split(Filepath, "\")(UBound(Split(Filepath, "\"))), ".xlsm", Format(Date, "dd_mm_yyyy") & ".xlsx")
With ThisWorkbook
Application.DisplayAlerts = False
.SaveAs SaveName, FileFormat:=xlWorkbookDefault
Application.DisplayAlerts = True
End With
Notice I'm using the object src to get the path where you want to save the new workbook, so you need to asign the line SaveName = .... anywhere before you do src.Close.
I have a function that basically makes a copy of the current file, and save it to users' "Downloads" folder.
However, while the SaveAs works, the output does not contain any modules. Instead, they are all linked to the exporting file.
Sub PushToProduction()
Application.ScreenUpdating = False
' save a copy of current file to the Downloads folder
outputPath = Environ$("USERPROFILE") & "\Downloads\"
d = Format(Date, "yyyymmdd")
fileName = outputPath & "REDACTED " & d & " v1.00.xlsm"
' prepare to save a copy of the file without the last tab
sheetCount = Application.Sheets.Count - 1
Dim tabs() As String
ReDim tabs(1 To sheetCount)
For i = 1 To sheetCount
tabs(i) = Worksheets(i).Name
Next
Worksheets(tabs).Copy
ActiveWorkbook.SaveAs fileName, XlFileFormat.xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("Success!")
End Sub
The output does not even have the "Modules" folder.
Is there anyway to solve this?
Create a Workbook Copy and Modify It
Option Explicit
Sub PushToProduction()
Dim dFolderPath As String
dFolderPath = Environ$("USERPROFILE") & "\Downloads\"
Dim d As String: d = Format(Date, "yyyymmdd")
Dim dFilePath As String
dFilePath = dFolderPath & "REDACTED " & d & " v1.00.xlsm"
Application.ScreenUpdating = False
' Create a reference to the Source Workbook ('swb').
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
' Save a copy of the Source Workbook.
If StrComp(dFilePath, swb.FullName, vbTextCompare) = 0 Then
MsgBox "You are trying save a copy of the file to the same location.", _
vbCritical, "Push to Production"
Exit Sub
End If
swb.SaveCopyAs dFilePath
' Open the copy, the Destination Workbook ('dwb'), remove its last sheet
' and close saving the changes.
Dim dwb As Workbook: Set dwb = Workbooks.Open(dFilePath)
Application.DisplayAlerts = False
dwb.Sheets(dwb.Sheets.Count).Delete
Application.DisplayAlerts = True
dwb.Close SaveChanges:=True
Application.ScreenUpdating = True
' Inform.
MsgBox "Success!", vbInformation, "Push to Production"
' Explore Destination Folder.
'swb.FollowHyperlink dFolderPath
End Sub
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
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
When I try to save my file with the ActiveWorkbook.Save function. The file get's corrupted and i cannot use it anymore.
I already tried the ActiveWorkbook.SaveCopyAs function, but the result is the same. Below the example. I have added the 2 other functions used on the bottom.
Sub Publish_WB()
Dim ws As Worksheet
Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String
If CheckPublished() Then
MsgBox ("Published version, feature not available ...")
Exit Sub
End If
NoUpdate
PublishInProgress = True
'Save the Current Workbook
OriginalFname = ActiveWorkbook.Path & "\" & ThisWorkbook.Name
'Store the current path
CurrentPath = CurDir
'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path
NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")
FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
ActiveWorkbook.SaveAs FName, 52
ActiveWorkbook.SaveCopyAs (OriginalFname)
Else
'user has cancelled
GoTo einde
End If
function CheckPublished()
Function CheckPublished() As Boolean
If Range("Quoting_Tool_Published").Value = True Then
CheckPublished = True
Else
CheckPublished = False
End If
End Function
and the NoUpdate :
Sub NoUpdate()
If NoUpdateNested = 0 Then
CurrentCalculationMode = Application.Calculation 'store previous mode
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Application.Cursor = xlWait
NoUpdateNested = NoUpdateNested + 1
' Debug.Print "NoUpdate, Noupdatenested = " & NoUpdateNested
End Sub
if we jump to einde, I call the following function :
Sub UpdateAgain()
NoUpdateNested = NoUpdateNested - 1
If NoUpdateNested < 1 Then
Application.Calculation = xlCalculationAutomatic 'let all sheets be calculated again first
Application.Calculation = CurrentCalculationMode 'set to previous mode
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Cursor = xlDefault
Else
Application.Calculation = xlCalculationAutomatic 'recalculate sheets, but keep the rest from updating
Application.Calculation = xlCalculationManual
End If
'Debug.Print "UpdateAgain, Noupdatenested = " & NoUpdateNested
End Sub
By using a name for the workbook than rather activeworkbook I was able to solve the problem; the rest of the code is the same, so the rest was not causing any issues.
Sub Publish_WB()
Dim ws As Worksheet
Dim wb as Workbook
Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String
If CheckPublished() Then
MsgBox ("Published version, feature not available ...")
Exit Sub
End If
NoUpdate
PublishInProgress = True
'Save the Current Workbook
Set wb = ThisWorkbook
wb.Save
'Store the current path
CurrentPath = CurDir
'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path
NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")
FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
wb.SaveAs FName, 52
Else
'user has cancelled
GoTo einde
End If