I am saving a copy of a workbook as a non-macro enabled workbook with some of the backend sheets hidden. I prefer to keep the backend sheets in the workbook for record keeping.
The first sheet in the workbook is one of the hidden sheets, here named "Sheet1". For some reason, when I open a copy of the newly saved workbook, it's not hidden anymore. I can even see that it was correctly hidden after the VBA saves if I add a breakpoint between saving and closing.
Any help with figuring this out is appreciated!
Sub MyVBA()
Dim ws As Worksheet
Dim wsName As Variant
'The string in quotes is what name the report should save and email as.
wsName = "My Workbook - "
ActiveWorkbook.Save
'Saves a master copy
'Name the first and last of the backend sheets you want to hide before saving a master. It will hide everything in between.
For i = Sheets("Sheet1").Index To Sheets("Sheet5").Index
Sheets(i).Select Replace:=False
Next i
ActiveWindow.SelectedSheets.Visible = False
ThisWorkbook.Sheets.Copy
With ActiveWorkbook
.SaveAs ThisWorkbook.Path & "\" & wsName & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=51
.Close
End With
End Sub
EDIT:
I tested it out with explicit references, and I'm getting the same issue.
For i = Sheets("Data").Index To Sheets("Key").Index
Sheets(i).Select Replace:=False
Next i
Workbooks("Test.xlsm").Windows(1).SelectedSheets.Visible = False
Workbooks("Test.xlsm").Sheets.Copy
With ActiveWorkbook
.SaveAs Workbooks("Test.xlsm").Path & "\" & wsName & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=51
.Close
End With
The reason this happens is due to your sheets.copy selecting the hidden sheet1. I modified your code to activate the last sheet # in your workbook after you copy your sheets.
Sub MyVBA()
Dim ws As Worksheet, i As Long
Dim wsName As Variant
'The string in quotes is what name the report should save and email as.
wsName = "My Workbook - "
ActiveWorkbook.Save
'Saves a master copy
'Name the first and last of the backend sheets you want to hide before saving a master. It will hide everything in between.
Dim LastSht As Long
LastSht = ThisWorkbook.Sheets.Count
For i = Sheets("Sheet1").Index To Sheets("Sheet5").Index
Sheets(i).Select Replace:=False
Next i
ActiveWindow.SelectedSheets.Visible = False
ThisWorkbook.Sheets.Copy
Sheets(LastSht).Activate
With ActiveWorkbook
.SaveAs ThisWorkbook.path & "\" & wsName & Format(Date, "yyyy-mm-dd") & ".xlsx", FileFormat:=51
.Close
End With
End Sub
Related
The code below should save every sheet in my automated file. Why does it save the whole file again and again with sheets(i) simply highlighted?
Sub Splitbook()
MyPath = ThisWorkbook.Path
For i = 1 To Worksheets.Count
Sheets(i).Activate
Sheets(i).SaveAs _
Filename:=MyPath & "\" & Sheets(i).Name & ".xlsx"
'ActiveWorkbook.Close savechanges:=False
Next i
End Sub
As #braX said - Each sheet will be saved in a new workbook.
As #TimWilliams said - each sheet needs copying to a new workbook before saving.
ThisWorkbook is the file containing the VBA code.
When a worksheet is copied to a new file the new file becomes the active workbook so we can reference it that way (it would be great if we could write Set wrkBk = wrkSht.Copy, but VBA doesn't like that).
Once we have a reference to the new file we can save it using the sheet name - you may want to add code that ensures the sheet name is a viable file name.
Public Sub SplitWorkbook()
Dim wrkSht As Worksheet
Dim wrkBk As Workbook
For Each wrkSht In ThisWorkbook.Worksheets
wrkSht.Copy
Set wrkBk = ActiveWorkbook
'Save the new file without closing.
'wrkBk.SaveAs ThisWorkbook.Path & "\" & wrkBk.Worksheets(1).Name
'Save the new file and close.
wrkBk.Close True, ThisWorkbook.Path & "\" & wrkBk.Worksheets(1).Name
Next wrkSht
End Sub
I have a macro that fills in then saves tracking numbers to a .csv file and I want to have Worksheets(1) active when I close the Workbook. The problem I am having is that it will save and close the Workbook on Worksheets("Tracking"). I have tried to select or activate Worksheets(1) then re-save and close but I can't seem to have it work.
Here is my code for saving the .csv file and closing the workbook.
Dim ws as Worksheet
Set ws = ActiveWorkbook.Worksheets("Tracking")
ws.Select
Dim sFileName As String
sFileName = ActiveWorkbook.path & "\" & Left(ws.name, InStr(1, ActiveWorkbook.name, ".") - 1) & ".csv"
Application.DisplayAlerts = False
'Save Current workbook just in case latest additions not saved.
ActiveWorkbook.Save
'Now create a CSV of the active sheet.
ws.SaveAs Filename:=sFileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True 'turn it back on
ActiveWorkbook.Close True 'Close and quit excel
Application.Quit
If all you are trying to do is have excel open on a specific sheet, you can try using the built-in workbook_open.
Private Sub Workbook_Open()
Sheets(“Sheet1”).Select
End Sub
The changes for selecting the sheet and the range.
Sub Macro1()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet2")
ws.Select
Dim sFileName As String
sFileName = ActiveWorkbook.Path & "\" & Left(ws.Name, InStr(1, ActiveWorkbook.Name, ".") - 1) & ".csv"
Application.DisplayAlerts = False
'Save Current workbook just in case latest additions not saved.
Sheets(1).Select
Range("A1").Select
ActiveWorkbook.Save
'Now create a CSV of the active sheet.
ws.SaveAs Filename:=sFileName, FileFormat:=xlCSV, CreateBackup:=False
Application.DisplayAlerts = True 'turn it back on
ActiveWorkbook.Close True 'Close and quit excel
Application.Quit
End Sub
I have a code that copies two worksheets from one workbook to a new one.
Since those two worksheets contain graphs where the data is on the sheet itself, but the datacells refer to a different worksheet, I copy the values only, to avoid external links.
However I found out that there is still an external link to my original workbook.
I don't know where it is though, since there are no formulas anymore.
I thought about names and deleted them as well, since there were a lot of names, that didn't even exist in the original file. That didn't help either.
I can delete the external, when using the menu in the ribbon.
And the code below also works, when I use it in the new workbook itself when opening it and running it in there.
Sub BreakLinks()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
End Sub
However, if I want to use that code in conjunction with the copying, it does not do the trick. I saved it on purpose before breaking the link, because I thought it might not be able to do it, but it didn't help.
Does anybody know why it doesn't work or can point me to a solution?
Here's the complete code:
Sub ACTION_Export_Capex()
Dim Pfad As String
Dim Dateiname As String
Dim ws As Worksheet
Dim wb As Workbook
Pfad = "D:\#Inbox\"
Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx"
'Copy Sheets without formulas
Sheets(Array("Capex_monthly", "Capex_YTD")).Copy
For Each ws In Worksheets
ws.UsedRange = ws.UsedRange.Value
Next
'get rid of macrobuttons and hyperlinks
For Each ws In Worksheets
ws.Rectangles.Delete
ws.Hyperlinks.Delete
Next
ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook
'delete external links
If Not IsEmpty(ActiveWorkbook.LinkSources(xlExcelLinks)) Then
For Each link In ActiveWorkbook.LinkSources(xlExcelLinks)
ActiveWorkbook.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
ActiveWorkbook.Save
ActiveWorkbook.Close
'go back to main menu in Cockpit
Sheets("Menu").Select
End Sub
Thanks a lot in advance.
EDIT:
In the end brettdj got the solution, I just had to tweak it a bit to get it done in my workbook.
Here's the code:
Sub ACTION_Export_Capex()
Dim Pfad As String
Dim Dateiname As String
Dim ws As Worksheet
Dim wb As Workbook
Pfad = "D:\#Inbox\"
Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx"
'Copy Sheets without formulas
Sheets(Array("Capex_monthly", "Capex_YTD")).Copy
For Each ws In Worksheets
ws.UsedRange = ws.UsedRange.Value
Next
'get rid of macrobuttons and hyperlinks
For Each ws In Worksheets
ws.Rectangles.Delete
ws.Hyperlinks.Delete
Next
'get rid of external link
ActiveWorkbook.ChangeLink ThisWorkbook.Name, ActiveWorkbook.Name, xlLinkTypeExcelLinks
ActiveWorkbook.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Sheets("Menu").Select
End Sub
If I use this code the links are gone when the new worbook is opened again.
I am still puzzled why the original creation builds in a phantom link that exists even when the two copied sheets are deleted.
code
Sub Test()
Dim wb As Workbook
Dim wb2 As Workbook
Dim Pfad As String
Dim Dateiname As String
Dim ws As Worksheet
With Application
.ScreenUpdating = False
.DisplayAlerts = falser
End With
Pfad = "D:\#Inbox\"
'Pfad = "c:\temp\"
Dateiname = Format(Date, "YYYY-MM-DD") & " " & Format(Time, "hhmm") & " " & "monthly Report-" & Format(DateSerial(Year(Date), Month(Date) - 1, 1), "yyyy-mm") & " Capex" & ".xlsx"
Set wb = ThisWorkbook
Set wb2 = Workbooks.Add(1)
wb.Sheets(Array("Capex_monthly", "Capex_YTD")).Copy After:=wb2.Sheets(1)
wb2.Sheets(1).Delete
wb2.SaveAs Filename:=Pfad & Dateiname, FileFormat:=xlOpenXMLWorkbook
wb2.ChangeLink wb.Name, wb2.Name, xlLinkTypeExcelLinks
wb2.Close
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Goto wb.Sheets("Menu").[a1]
End With
Set wb2 = Workbooks.Open(Pfad & Dateiname)
End Sub
I have found a decent solution Saving excel worksheet to CSV files with filename+worksheet name using VB for saving all worksheets in a workbook as CSV files. However, I would like to be able to modify this code to only save worksheets where the sheet name ends with _t.
I am using the following code:
Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
Can this be done?
Use the Right or Instr-Method on the worksheet.name property to get the last characters / check if your searchstring is exisiting.
In your for each-loop add the following code:
If Right(WS.name, 2) = "_t" Then
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
End if
Objective:
To save specific worksheets in a workbook as unique CSV files
Conditions:
To save specific worksheets (plural) from a workbook that contains both the specific worksheets and extraneous worksheets (e.g. to save specific 10 out of 20 available worksheets)
Insert the current date into the CSV's file name in order to avoid overwriting files currently in the save folder (this VBA is run daily)
File name syntax: CurrentDate_WorksheetName.csv
I've found VBA code that gets me half way to my goal. It saves ALL worksheets in the workbook but the file name is not dynamic with the current date.
Current Code:
Private Sub SaveWorksheetsAsCsv()
Dim WS As Excel.Worksheet
Dim SaveToDirectory As String
Dim DateToday As Range
Dim CurrentWorkbook As String
Dim CurrentFormat As Long
CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "S:\test\"
For Each WS In ThisWorkbook.Worksheets
Sheets(WS.Name).Copy
ActiveWorkbook.SaveAs Filename:=SaveToDirectory & WS.Name & ".csv", FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
' about overwriting the original file.
End Sub
There are several issues with your code:
i) There is no reason to save the format or name of your current workbook. Just use a new workbook to save the CSVs that you want.
ii) You were copying each worksheet in the book, but not copying it anywhere. This code was actually saving the same workbook with the name of each sheet. Copying the worksheet doesn't paste it anywhere and doesn't actually tell the saving function only to use parts of the document.
iii) To put the date in the name, you just need to append it to the save name string, as below.
Dim myWorksheets() As String 'Array to hold worksheet names to copy
Dim newWB As Workbook
Dim CurrWB As Workbook
Dim i As Integer
Set CurrWB = ThisWorkbook
SaveToDirectory = "S:\test\"
myWorksheets = Split("SheetName1, SheetName2, SheetName3", ",")
'this contains an array of the sheets.
'If you want more, put another comma and then the next sheet name.
'You need to put the real sheet names here.
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
Set newWB = Workbooks.Add 'Create new workbook
CurrWB.Sheets(Trim(myWorksheets(i))).Copy Before:=newWB.Sheets(1)
'Copy worksheet to new workbook
newWB.SaveAs Filename:=SaveToDirectory & Format(Date, "yyyymmdd") & myWorksheets(i), FileFormat:=xlCSV
'Save new workbook in csv format to requested directory including date.
newWB.Close saveChanges:=False
'Close new workbook without saving (it is already saved)
Next i
CurrWB.Save 'save original workbook.
End Sub
It seems to me that in that code was a lot of unnecessary stuff but the most important part was almost ready.
Try this:
Sub SaveWorksheetsAsCsv()
Dim WS As Worksheet
Dim SaveToDirectory As String
SaveToDirectory = "C:\tmp\"
Application.DisplayAlerts = False
For Each WS In ThisWorkbook.Worksheets
WS.SaveAs Filename:=SaveToDirectory & Format(Now(), "yyyymmdd") & "_" & WS.Name & ".csv", FileFormat:=xlCSV
Next
Application.DisplayAlerts = True
End Sub