Currently trying to figure out how to have my code that auto saves and closes open workbooks to avoid vba project workbooks without naming the vba project workbooks. Is there a way to get your code to recognize vba workbooks vs the other open workbooks I'm trying to save and close?
Option Explicit
Public ThisFile As String
Public Path As String
Sub CloseAndSaveOpenWorkbooks()
Dim Wkb As Workbook
Path = [D1]
With Application
.ScreenUpdating = False
'Loop through the workbooks collection
For Each Wkb In Workbooks
With Wkb
'If NOT on Macro workbook then
If .Name <> ThisWorkbook.Name Then
'If the book is read-only
'don't save but close
If Not Wkb.ReadOnly Then
'Save current workbook with current workbooks cell A1 as file name
.SaveAs Filename:=(Path & "\" & Wkb.Sheets(1).Range("A1").Value & ".xls"), FileFormat:=xlExcel8
End If
'Closing here leaves the app running, but no books
.Close
End If
End With
Next Wkb
.ScreenUpdating = True
End With
End Sub
A follow up question to thread: VBA: Auto save&close out of all current workbooks except for Macro workbook
Got my answer!
Reading through Article Provided by J_V most definitely helped.
I replaced
If .Name <> ThisWorkbook.Name Then
with
If Wkb.HasVBProject = False Then
Hope this ends up helping others. Thanks again J_V!
Related
i need to find a way to delete all the excel workbooks but the active one after some condition is fulfilled. I am new to VBA, so it is possible that I got here some very basic problem (but I couldn't find similar question here on SO). Here's my code:
Sub kill()
Dim wb As Workbook
Dim A As String
A = 2
If A = 1 Then
MsgBox "Everything is fine"
'The if condition is working just fine
Else
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
If Not (wb Is Application.ActiveWorkbook) Then
Application.DisplayAlerts = False
If wb.Path <> vbNullString Then
wb.ChangeFileAccess vbNormal
kill (wb.FullName)
End If
ThisWorkbook.Close SaveChanges:=False
End If
Next
End If
End Sub
The if condition is working well, but VBA seems to have a difficulties with the kill command, which confuses me since the "killing" part is working perfectly when not put inside of the If Not condition.
Thank you very much for any suggestions you could provide.
Best regards,
Maritn
If you want just to close all workbooks but active one, you could use the code I paste below:
Dim wb As Workbook
For Each wb In Application.Workbooks
If wb.Name <> ActiveWorkbook.Name Then
wb.Save
wb.Close
End If
Next wb
If you want rather to close all workbooks except of the one that have this macro inside, replace ActiveWorkbook with ThisWorkbook. Other thing is to delete all files. This is obviously risky operation, so I would suggest to restrict it to the specific folder. It happened that I have one subroutine of this kind, see:
Sub DeleteFilesFromFolder()
Dim myPath
myFolder = Sheets("Main").Range("B4").Value
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each Filename In fldr.Files
Filename.Delete True ' delete all files
Next
End Sub
The path of the folder to clean is the specific cell, you can put it elsewhere, as you wish. It won't delete open workbook, if you want to avoid error messages, just use On Error Resume Next.
So, my suggestion is first to close all workbooks, then delete closed.
I appreciate there are lots of entries like save individual excel sheets as csv
and Export each sheet to a separate csv file - But I want to save a single worksheet in a workbook.
My code in my xlsm file has a params and data sheet. I create a worksheet copy of the data with pasted values and then want to save it as csv. Currently my whole workbook changes name and becomes a csv.
How do I "save as csv" a single sheet in an Excel workbook?
Is there a Worksheet.SaveAs or do I have to move my data sheet to another workbook and save it that way?
CODE SAMPLE
' [Sample so some DIMs and parameters passed in left out]
Dim s1 as Worksheet
Dim s2 as Worksheet
Set s1 = ThisWorkbook.Sheets(strSourceSheet)
' copy across
s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy
' Create new empty worksheet for holding values
Set s2 = Worksheets.Add
s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' save sheet
s2.Activate
strFullname = strPath & strFilename
' >>> BIT THAT NEEDS FIXIN'
s2.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, CreateBackup:=True
' Can I do Worksheets.SaveAs?
Using Windows 10 and Office 365
This code works fine for me.
Sub test()
Application.DisplayAlerts = False
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
It's making a copy of the entire strSourceSheet sheet, which opens a new workbook, which we can then save as a .csv file, then it closes the newly saved .csv file, not messing up file name on your original file.
This is fairly generic
Sub WriteCSVs()
Dim mySheet As Worksheet
Dim myPath As String
'Application.DisplayAlerts = False
For Each mySheet In ActiveWorkbook.Worksheets
myPath = "\\myserver\myfolder\"
ActiveWorkbook.Sheets(mySheet.Index).Copy
ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Next mySheet
'Application.DisplayAlerts = True
End Sub
You just need to save the workbook as a CSV file.
Excel will pop up a dialog warning that you are saving to a single sheet, but you can suppress the warning with Application.DisplayAlerts = False.
Don't forget to put it back to true though.
Coming to this question several years later, I have found a method that works much better for myself. This is because the worksheet(s) I'm trying to save are large and full of calculations, and they take an inconvenient amount of time to copy to a new sheet.
In order to speed up the process, it saves the current worksheet and then simply reopens it, closing the unwanted .csv window:
Sub SaveThisSheetInParticular()
Dim path As String
path = ThisWorkbook.FullName
Application.DisplayAlerts = False
Worksheets("<Sheet Name>").SaveAs Filename:=ThisWorkbook.path & "\<File Name>", FileFormat:=xlCSV
Application.Workbooks.Open (path)
Application.DisplayAlerts = True
Workbooks("<File Name>.csv").Close
End Sub
Here the Sheet and csv filename are hardcoded, since nobody but the macro creator (me) should be messing with them. However, it could just as easily be changed to store and use the Active Sheet name in order to export the current sheet whenever the macro is called.
Note that you can do this with multiple sheets, you simply have to use the last filename in the close statement:
Worksheets("<Sheet 1>").SaveAs Filename:=ThisWorkbook.path & "\<File 1>", FileFormat:=xlCSV
Worksheets("<Sheet 2>").SaveAs Filename:=ThisWorkbook.path & "\<File 2>", FileFormat:=xlCSV
[...]
Workbooks("<File 2>.csv").Close
I am attempting to merge specific xls files into one sheet, but I get a runtime error 1004 saying " Copy method of Worksheet class failed" I am thinking this is because I am trying to merge over 100 files?
Sub GetSheets()
Path = "C:\Users\..."
Filename = Dir(Path & "*100.00mA.isd.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
**Sheet.Copy After:=ThisWorkbook.Sheets(1)**
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
I have occssionally run into a "timing" problem with xl2003 and ActiveWorkbook, maybe this is causing your problem. Sometimes the VBA code gets to the ActiveWorkbook line before Excel has the new workbook fully opened, consequently, ThisWorkbook becomes the ActiveWorkbook. The way to work around this is to specifically assign a variable to the new workbook.
Sub GetSheets()
Dim wB As Workbook '<=New
Path = "C:\Users\..."
Filename = Dir(Path & "*100.00mA.isd.xls")
Do While Filename <> ""
Set wB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True) '<=New
For Each Sheet In wB.Sheets '<=New
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
wB.Close '<=New
Filename = Dir()
Loop
End Sub
There is another situation, where the described runtime error will appear:
In the case that your target workbook is an Excel 97-2003 file (.xls) and your source workbook is an Excel 2007 (or higher) file (.xlsx).
Having this combination, the sheet.copy method will cause the same runtime error.
You may check the different workbook formats by reading the ActiveWorkbook.FileFormat property.
I'm trying to close all currently open Workbooks except for my Macro workbook, and .SaveAs my path, but I want my path to be a specified cell within my macro workbook [D1] to be precise. I also want the file name to be saved as cell A1 in the Workbook that I'm currently saving and closing out of. Now I'm stuck. I've listed the code that I'm utilizing currently, and the issue I'm running into with this piece of code is that it's saving as the name in cell A1 in the currently selected Workbook vs the Workbook the code is currently cycling on. I hope this makes sense.
Option Explicit
Public ThisFile As String
Public Path As String
Sub CloseAndSaveOpenWorkbooks()
Dim Wkb As Workbook
' ThisFile = ActiveWorkbook.Sheets(1).Range("A1").Value ** Commented out as this piece of code was not working as intended **
Path = "C:\Users\uuis\Desktop"
With Application
.ScreenUpdating = False
' Loop through the workbooks collection
For Each Wkb In Workbooks
With Wkb
If .Name <> ThisWorkbook.Name Then
' if the book is read-only
' don't save but close
If Not Wkb.ReadOnly Then
.SaveAs Filename:=(Path & "\" & ActiveWorkbook.Sheets(1).Range("A1").Value & ".xls"), FileFormat:=xlExcel8
End If
' We save this workbook, but we don't close it
' because we will quit Excel at the end,
' Closing here leaves the app running, but no books
.Close
End If
End With
Next Wkb
.ScreenUpdating = True
' .Quit 'Quit Excel
End With
End Sub
ActiveWorkbook.Sheets(1).Range("A1").Value
should be
Wkb.Sheets(1).Range("A1").Value
I have a code written for one excel sheet in the form of Macro, In this macro, I am generating a copy of current workbook to a different location. Now, I need to access this copied excel workbook to delete some of its Worksheets from the macro.
can anyone tell me how to access the newly copied sheet from the current excel sheet macro?
The following code will allow you to edit a copy of your workbook:
Sub test()
Dim wb As Workbook
Dim strName as String
strName = "" & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs Filename:=strName
Set wb = Workbooks.Open(strName)
Application.DisplayAlerts = False 'Prevents that user is asked when sheets are deleted
wb.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
wb.Close SaveChanges:=True
End Sub