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
Related
I'm trying to save a folder of excel sheets as .csv. However, I only able to save the .csv of the active sheet. Would it be possible to specify which sheet within these folder of excel files that I would like to extra it from?
Thank you so much !
Where should I put the sheetname in my code to specify that the looping should only occur for that particular sheet? Thank you!
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
nameWb = myPath & Left(myFile, InStr(1, myFile, ".") - 1) & ".csv"
ActiveWorkbook.SaveAs Filename:=nameWb, FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
'Get next file name
myFile = Dir
Loop
I'm doing roughly the same in my project. I copy the WS I want to save to a new WB, and then save the new file.
Workbooks(ExportFile).Worksheets(ExportSheet).Copy
ActiveWorkbook.SaveAs "path/" & ExportSheet & ".txt", FileFormat:=xlCSV
As far as I know, making copies of the worksheets is the only way of saving specific worksheets.
Here's how to loop through the sheets. You basically probably are going to test if the name matches your pre-determined list. You could also use error checking for named ranges, or a wide variety of other ways to flag which sheets to use.
'define variables
Dim wb As Workbook, WS As Worksheet
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Here's the loop you are looking for I think
For Each WS In wb.Worksheets
'OR statements/If statements can be used.
'Also lookout for name syntax being case-sensative. You might
'want to include Ucase on both sides to defend against inconsistencies.
If WS.Name = "LetsDoThisSheet!" Or UCase(WS.Name) = UCase("AndThisone2") Then
WS.Visible = xlSheetVisible
WS.Activate
nameWb = myPath & Left(myFile, InStr(1, myFile, ".") - 1) & ".csv"
ActiveWorkbook.SaveAs Filename:=nameWb, FileFormat:=xlCSV
ActiveWorkbook.Close savechanges:=False
End If
Next WS
'Get next file name
myFile = Dir
Loop
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
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
I need to copy information from one excel file to other using VBA. Code makes new workbook in certain destination (*C:\Users\eliza_000\Desktop\aaa*) for whole sheet (inv) but I need only range A1:E32 in the new workbook.
Here is the code what I use to copy all sheet
Sub SaveInvWithNewName()
Dim NewFN As Variant
'Copy Invoice to a new workbook
ActiveSheet.Copy
NewFN = "C:\Users\eliza_000\Desktop\aaa\inv" & Range("E6").Value & ".xlsx"
ActiveWorkbook.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
End Sub
Consider:
Sub dural()
ActiveSheet.Copy
Rows("33:1048576").Delete
Columns("F:xfd").Delete
End Sub
Adjust if you are using a version of Excel pre-2007.
Something like:
Dim WB As Workbook
Dim WB2 As Workbook
Dim NewFN As String
Set WB = ThisWorkbook
Set WB2 = Workbooks.Add(1)
WB.ActiveSheet.Range("A1:E32").Copy WB2.Sheets(1).Range("a1")
NewFN = "C:\Users\eliza_000\Desktop\aaa\inv" & Range("E6").Value & ".xlsx"
NewFN = "C:\temp\stuff.xlsx"
WB2.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook
WB2.Close
I have a folder called "maildir". It contains folders named numerically. These folders contain text files.
I have hacked together a macro that opens the numerically named folder, opens its first text file, and copies the contents into Excel. It then opens the next file in the directory, and copies the new file into a new sheet in the same workbook.
Then, the procedure deletes all the rows below row five, for every sheet in the workbook.
The next step combines the content from all the sheets into a new sheet called "Combined".
Then, all sheets but "Combined" are deleted
The next step saves the workbook into a new folder called "enron_excel".
This is where I am stuck: I was able to get the macro to work fine until I added a "For Loop" which is designed to both open the numerically named folders, and save them with numerical names in the "enron_excel" folder.
But when I run the code, and look in the "enron_excel" folder, it seems that the "combined" step has been missed. Does anyone know what happened?
Thank you.
Sub all()
Application.DisplayAlerts = False
Dim J As Integer
Dim ws As Worksheet
Dim wks As Worksheet
For i = 1 To 3 ' What I want this for loop to do: open the file called "1" (and later 2 and 3), manipulate the data then save with the same number in a different file
Path = "C:\Users\Kate\Desktop\enron4\maildir\" ' open folder in a directory
Filename = Dir(Path & i & "*.txt") ' opens a folder, and a text file in that folder
Do While Filename <> "" ' opens file in folder and copies to sheet in excel workbook
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
For Each ws In ThisWorkbook.Worksheets ' deletes all the rows below row five
ws.Range("5:1000").Delete
Next ws
On Error Resume Next
Sheets(1).Select ' combines all the sheets into one worksheet
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next J
Sheets("Combined").Select ' selects the sheet calls "Combined" and deletes all the others
Application.DisplayAlerts = False
For Each wks In Worksheets
If wks.Name <> ActiveSheet.Name Then wks.Delete
Next wks
Path = "C:\Users\Kate\Desktop\enron_excel\" ' this opens a new path
FolderName = i
ActiveWorkbook.SaveAs Filename:=Path & FolderName ' this saves the file in the new path with the new name
Application.DisplayAlerts = True
Next i
End Sub
Why don't you use File System Object.
Something like:
Sub ReadAllfiles()
Dim fso As Scripting.FileSystemObject
Dim sFile As Scripting.File
Dim subFldr As Scripting.Folder
Dim wbName As String
Dim fldrPath As String
Dim fname As String
Dim fldrDesc As String
Dim wbTxt As Workbook
Dim ws As Worksheet
Dim wbDesc As Workbook
fldrDesc = "C:\User\Yourdestination\" '<~~ change to suit
fldrPath = "C:\User\Yourfolder" '<~~ change to suit
'iterate each folder of your source folder
Set fso = New Scripting.FileSystemObject
For Each subFldr In fso.GetFolder(fldrpath).SubFolders
wbName = subFldr.Name
Set wbDesc = Workbooks.Add 'add a new workbook
'create the combined sheet
Set ws = wbDesc.Sheets(1): ws.Name = "Combined"
'iterate each file on the folder
For Each sFile In subFldr.Files
fname = sFile.ParentFolder.Path & "\" & sFile.Name
Set wbTxt = Workbooks.Open(fname)
'I'm not sure why a text file will yield to multiple sheet
'so if that is really the case use your loop
'copy the 1st 4 rows to Combined sheet
wbTxt.Sheets(1).Range("1:4").Copy _
ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
wbTxt.Close False 'close source text file
Next
wbDesc.SaveAs fldrDesc & wbName 'save the workbook
wbDesc.Close True 'close
Next
End Sub
I just based it on how you describe what you want. Not tested though.
You will need to add reference to Microsoft Scripting Runtime. HTH.