I've got part of the code:
Workbooks.Add
ActiveWorkbook.SaveAs filename:=Application.GetSaveAsFilename(fileFilter:="Excel Workbook (*.xlsx), *.xlsx")
So the user selects where and what name the workbook should have. However, if he clicks "Cancel" or tries to close the window, the workbook still saves under the name "False". How to stop that? The best solution would be to exit sub if the user clicks "Cancel" or closes the window
I recommend not to use ActiveWorkbook at all. Instead reference the newly added workbook directly.
Option Explicit
Public Sub SaveEample()
Dim NewWb As Workbook
Set NewWb = Workbooks.Add 'set the new added workbook to a variable so we can access it later
Dim FileLocation As Variant
FileLocation = Application.GetSaveAsFilename(fileFilter:="Excel Workbook (*.xlsx), *.xlsx")
If Not FileLocation = False Then
NewWb.SaveAs FileName:=FileLocation
End If
End Sub
Dim s as Variant
s = Application.GetSaveAsFilename(fileFilter:="Excel Workbook (*.xlsx), *.xlsx")
if s = False then
else
ActiveWorkbook.SaveAs filename:=s
end if
The method returns false when the user clicks Cancel, so you have to check for this case. Something like this should work for you:
fileSaveName = Application.GetSaveAsFilename(fileFilter:="Text Files (*.txt), *.txt")
If fileSaveName <> False Then
ActiveWorkbook.SaveAs filename := fileSaveName
End If
Using #Pᴇʜ code I modified my to work like I want to:
Set NewWb = Workbooks.Add
genpath = Application.GetSaveAsFilename(fileFilter:="Excel Workbook (*.xlsx), *.xlsx")
If Not genpath = False Then
NewWb.SaveAs filename:=genpath
Else
NewWb.Close
Exit Sub
End If
Related
I could have sworn that this was working before - but for some reason, this doesn't appear to be working anymore. I'm trying to take the active worksheet (also, this may not be very pretty or clean, but I am still really new to VBA), copy it to a new worksheet, in the new worksheet I want to open the Excel save as dialog, and when the worksheet is saved (in CSV) format, I want the workbook to close (or even if it doesn't close) at least return the user to the original workbook and end the sub
Sub saveExportAs()
Application.CutCopyMode = False
Sheets("load").Select
ActiveWorkbook.Activate
Sheets("load").Copy
Dim varResult As Variant
Dim ActBook As Workbook
'display the save as dialog
varResult = Application.GetSaveAsFilename(InitialFileName:="\\network\folder\upload_" & Format(Date, "yyyy-mm-dd") & ".csv", FileFilter:= _
"Comma Delimited / Upload Files (*.csv),*.csv", Title:="Save Upload File")
'check to make sure the user didn't cancel
If varResult <> False Then
ActiveWorkbook.saveAs Filename:=varResult, _
FileFormat:=xlCSV
Exit Sub
End If
End Sub
you can use the sheets defined as workbook/worksheet to avoid issues... may be like this :
Sub saveExportAs()
Dim wb1, wb2 As Workbook
Dim ws As Worksheet
Dim varResult As Variant
Set wb1 = ThisWorkbook
Set ws = ThisWorkbook.Worksheets("load")
ws.Copy
Set wb2 = ActiveWorkbook
varResult = Application.GetSaveAsFilename(InitialFileName:="\\network\folder\upload_" & Format(Date, "yyyy-mm-dd") & ".csv", FileFilter:= _
"Comma Delimited / Upload Files (*.csv),*.csv", Title:="Save Upload File")
If varResult <> False Then
wb2.SaveAs Filename:=varResult, FileFormat:=xlCSV
wb2.Close Savechanges:=True
Exit Sub
End If
wb1.Activate
End Sub
Try this...
Sub exportAsCSV()
Dim wb As Workbook
Set wb = ActiveWorkbook
SaveCopyAsCSV ("Sheet1") ' replace Sheet1 with whatever sheet name you need
wb.Activate
End Sub
Private Function SaveCopyAsCSV(SourceSheet As String)
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SourceSheet).copy
ActiveWorkbook.SaveAs fileName:=SourceSheet, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Function
I have a code below which copies a specific worksheets form all active or open workbooks.
But how to copy the same Worksheet without opening the workbooks, like if we can provide the path in the code , it should be able to pick the given worksheet from all the workbooks form that path.
Below is the code that am currently using.
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
sWksName = "SHEET NAME"
For Each wkb In Workbooks
If wkb.Name <> ThisWorkbook.Name Then
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
End If
Next
Set wkb = Nothing
End Sub
Work with Workbooks.Open Method to open it in in the background, and hide any alerts with Application / ScreenUpdating / EnableEvents / DisplayAlerts
Application.ScreenUpdating Property (Excel) Turn screen updating off to speed up your macro code. You won't be able to see what the macro is doing, but it will run faster.
Example
Sub CopySheets1()
Dim wkb As Workbook
Dim sWksName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
wkb Workbooks.Open("C:\temp\bookname.xls")
sWksName = "SHEET NAME"
For Each wkb In Workbooks
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Set wkb = Nothing
End Sub
Assuming your folder name is C:\Temp\ then Loop until folder returns an empty
Example
Dim FileName As String
' Modify this folder path as needed
FolderPath = "C:\Temp\"
' Call Dir the first time to all Excel files in path.
FileName = Dir(FolderPath & "*.xl*")
' Loop until Dir returns an empty .
Do While FileName <> ""
' Open a workbook in the folder
Set wkb = Workbooks.Open(FolderPath & FileName)
'--->> Do your copy here
' Close the source workbook without saving changes.
wkb.Close savechanges:=False
' next file name.
FileName = Dir()
Loop
Use a Do...Loop structure when you want to repeat a set of statements an indefinite number of times, until a condition is satisfied. If you want to repeat the statements a set number of times, the For...Next Statement is usually a better choice.
I am assuming that you don't want to display the opened workbook to the user so the operation is not visible on screen.
If that's the case, you can use the following line before your code
Application.ScreenUpdating = False
'open the new/target excel workbook and put all the sheets in there
And following after:
Application.ScreenUpdating = True
It seems then that you have to manually open the workbooks. You can automate this process in VBA as follows;
Sub CopySheets1()
Dim wkb As Workbook
Dim dirPath As String ' Path to the directory with workbooks
dim wkbName as String
dirPath="C:\folder\"
sWksName = "SHEET NAME"
wkbName=Dir(dirPath & "*.xlsx")
For example:
dirPath = "C:\folder\"
So that the input to the Dir function be like "C:\folder*.xlsx"
Application.DisplayAlerts = False
do while wkbName <> ""
Set wkb=Application.Workbooks.Open(dirPath & wkbName)
wkb.Worksheets(sWksName).Copy _
Before:=ThisWorkbook.Sheets(1)
wk.Close False
wkbName = Dir
loop
Application.DisplayAlerts = True
End Sub
I am using a macro that opens each excel file in the same folder that the workbook containing the macro (I'll call it the master workbook) is in and copies all the data in the first spreadsheet, then pastes them into the master workbook on a new worksheet. I found some very useful code online that I made a few changes to. Everything seems to be working fine, except that while this code is opening each file in the folder (in the Do Until loop), it opens itself half way through.
I'd like to be able to avoid this without referencing the master spread sheet's name directly, in case someone renames it.
Is there a simple command that will make skip the remaining code in the loop if it tries to open itself?
Code is below:
Sub CombineWSs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
Set wbDst = ThisWorkbook
strFilename = Dir(MyPath & "\*.xls", vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = ""
Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
'copy the data
wbSrc.ActiveSheet.UsedRange.Select
Selection.Copy
'create a new worksheet in this master file
wbDst.Sheets.Add After:=Sheets(Sheets.Count)
'paste the data into master file's new sheet
wbDst.Sheets(wbDst.Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Put an If block inside our loop
Do Until strFilename = ""
If strFilename <> wbDest.Name Then 'since you already set wbDest = ThisWorkbook
'... rest of code
End If
Loop
I am writing a macro where I take data from a CSV and copy it to another Excel file (not the current or active file).
What is the code to take the copied data and send it to another file in the same directory.
This is my code, I have commented out the lines that cause the macro not to work. I want to set the variable wshT to Sheet1 of the WTF.xlsx file, which is in the same directory but not the active workbook. I have not opened that one. So the goal is to use this macro to copy extra data from the CSV and send it to the WTF.xlsx file and save it as something new, in this case "BBB". Any help is much appreciated. When I uncomment those lines, errors pop up.
Sub Import()
Dim MyPath As String
Dim strFileName As String
'Dim strFileName1 As String
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
'strFileName1 = Workbooks("WTF.xlsx").Activate
'strFileName1 = Workbooks("WTF.xlsx").Worksheets("Sheet1").Select
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim wshT As Worksheet
'Set wshT = strFileName1
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.Range("A1:A3").EntireRow.Delete
'wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyPath & "\BBB", FileFormat _
:=51, CreateBackup:=False
Application.DisplayAlerts = False
'ActiveWindow.Close
End Sub
Your use of value assignment to strFileName1 through the use of .Activate and/or .Select was bad methodology. If WTF.xlsx is open, you can directly reference its Sheet1 and Set a worksheet object reference to a variable.
Sub Import()
Dim MyPath As String, strFileName As String
Dim wbkS As Workbook, wshS As Worksheet, wshT As Worksheet
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
Set wshT = Workbooks("WTF.xlsx").Worksheets("Sheet1")
wshS.Range("A1:A3").EntireRow.Delete
With wshS.Cells(1, 1).CurrentRegion
.Copy Destination:=wshT.Range("A1")
End With
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
wshT.Parent.SaveAs Filename:=MyPath & "\BBB", FileFormat:=51, CreateBackup:=False
wshT.Parent.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Another alternative would be to use the VBA equivalent of Data ► Get External Data ► From Text but you should probably know the number and type of fields being brought in with the CSV beforehand. This is certainly the preferred method if the CSV data is being incorrectly interpreted by the temp worksheet you are creating by opening the CSV as a workbook.
Looping through opened Workbooks
Its a code to which runs through all opened workbooks but here's a problem that it runs about 10 to 12 times then stops. Can anybody gimme any idea...
Sub OpenAllWorkbooks()
Set destWB = ActiveWorkbook
Dim DestCell As Range
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.csv*),*.csv*", _
Title:="Select the workbooks to load.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set wb = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
Next n
Dim cwb As Workbook
For Each cwb In Workbooks
'With Application
'cwb.AcceptAllChanges
'End With
Call donemovementReport
ActiveWorkbook.Close True
ActiveWorkbook.Close False
Next cwb
End Sub
Why open all workbooks in one go? Open them one by one and then close them as your work is done. For example (Untested)
Sub OpenAllWorkbooks()
Dim wb As Workbook, thisWb As Workbook
Dim DestCell As Range
Dim FileNames As Variant
Dim n As Long
Set thisWb = ThisWorkbook
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.csv*),*.csv*", _
Title:="Select the workbooks to load.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set wb = Workbooks.Open(Filename:=FileNames(n), ReadOnly:=True)
Call donemovementReport
wb.Close SaveChanges:=True
Next n
End Sub
The solution I use to cycle many files in 95% of cases - perhaps may be helpful:
Sub CSV_Cycling()
InputFolder = "D:\DOCUMENTS\"
LoopFileNameExt = Dir(InputFolder & "*.csv")
Do While LoopFileNameExt <> ""
'Application.DisplayAlerts = False
Application.Workbooks.Open (InputFolder & LoopFileNameExt)
'Application.DisplayAlerts = True
[..........YOUR CODE..........]
LoopFileNameExt = Dir
Loop 'Input Folder Files Cycling
End Sub
Uncomment Application.DisplayAlerts = strings to avoid any warnings - if required (however be careful - files will be opened using "default" options) and change source path, of course).