I have an excel file received on a monthly basis that includes multiple sheets. Each sheet needs to be split into .CSV files before it can be uploaded into our system for reading, and given that a single workbook might include upwards of 10 to 15 pages, it's a chore to do it by hand.
Presently, I'm using this VBA script to achieve the job:
Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".csv"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
It "works". The problem? When you try to open the generated csv windows complains about an extension mismatch and warns about corruption. If you click through the dialogue it opens anyway, but the target system can't do that. So I'm left with figuring out what's missing or going back to parsing by hand. Any help?
I've created a version which combines your code with the relevant parts of the other answer. The open workbook will take the names of each of the worksheets in turn. It will therefore be important to save your workbook BEFORE running this code. The version which is open at the end will have all the tabs, but they aren't in the saved CSV file of the same name.
If you want to save again at the end back to the original name and format, I think some of the other answers can help with that too.
I've removed the Worksheet Copy command and commented out the Application.ActiveWorkbook.Close False line as I wasn't sure what they were doing.
Sub Splitbook()
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.SaveAs Filename:=xPath & "\" & xWs.Name & ".csv", FileFormat:=xlCSV
'Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Related
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
Below is my code for saving the file without the VBA codes.
It saves together with the VBA codes.
Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.DisplayAlerts = False
ThisWorkbook.SaveAs "C:\Users\sgffa\Desktop\Profile_Macros\NEW\" & NFolder & "\" & "C",
FileFormat:=xlExcel8
Application.DisplayAlerts = True
Next x
End Sub
Save your project as xlsx instead of xlsm then the Code shouln'd be saved
you could first copy sheets in a new workbook and then save it
Sheets.Copy
Sheets.Select
Cells.Copy
Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs "C:\Users\sgffa\Desktop\Profile_Macros\NEW\" & NFolder & "\" & "C.xlsx"
Application.DisplayAlerts = True
.Close True
End With
from
ThisWorkbook.SaveAs "C:\Users\sgffa\Desktop\Profile_Macros\NEW\" & NFolder & "\" & "C", FileFormat:=xlExcel8
to this:
ThisWorkbook.SaveAs "C:\Users\sgffa\Desktop\Profile_Macros\NEW\" & NFolder & "\" & "C" & ".xlsx", FileFormat:=xlOpenXMLWorkbook
SaveAs Confusion
I'm confused, too. As it happens, when you save your macro enabled workbook (.xlsm) as macro not-enabled workbook (.xlsx), the workbook stays open still having the code in it. But the good thing is that it is saved without code. You can now save it, 'manually' SaveAs it, it will still be without code (macros) the next time you open it.
The code should demonstrate the following:
It is good practice to start with Option Explicit which will help
you by alerting you when something is wrong.
It is good practice to use constants at the beginning of the code,
especially for such long file paths, so when you have to change them
you can easily find them.
When you disable an event, there is a possibility you won't be able
to enable it again if you're not careful. If an error occurs, you should redirect
the code to enable those events again.
If you want to close the workbook, then use the line ThisWorkbook.Close
Option Explicit
Sub SaveMacroDisabled()
Const strPath = "I:\Excel\MyDocuments\Test\Test4\"
Const strXLSX = "BookMacroDisabled"
On Error GoTo ProgramError
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strXLSX, _
FileFormat:=xlWorkbookDefault
SafeExit:
Application.DisplayAlerts = True
' ThisWorkbook.Close
Exit Sub
ProgramError:
MsgBox "An unexpected error occurred"
On Error GoTo 0
GoTo SafeExit
End Sub
I have the following macro
(Macro than rename the sheet with the value of cell B4 and then create one workbook for each sheet.)
Sub RenameTabs()
'UpdatebyTony
For x = 1 To Sheets.Count
If Worksheets(x).Range("B4").Value <> "" Then
Sheets(x).Name = Worksheets(x).Range("B4").Value
End If
Next
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xls"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
But this means I have to go and copy the macro in each excel file and run it.
I would like to be able to run de macro and it open a dialog where it ask me to choose the excel file that I want to rename the sheets and separate? Is that possible?
I know very little about VBA
Get the path of the workbook you like to perform the macro from FileDialog. You can use
Application.FileDialog
https://msdn.microsoft.com/en-us/library/office/ff836226.aspx
Open the workbook and set a reference for it.
set wb =Application.Workbooks.Open(filepath)
On your current sub RenameTabs, replace Application.ActiveWorkbook, ThisWorkBook with wb. Also, you need to properly reference the Sheets, Worksheets, ... to wb. Alternatively, you should make it sure that wb is the ActiveWorkbook (wb.Activate) (you can break the code if you switch to another excel file when it is still processing)
I have been trying to find a quick solution to "merge" excel files, came across at least a dozen different codes, tried recording my own macro and modifying that (instead of a range of sheet names trying to select the lot etc.) none of worked anywhere near the way I wanted it to, most of them didn't work at all.
The context as follows:
I have a lot of files in a folder ("C:\Zoltan\TEST\"), most have multiple sheets. I want to copy
all the sheets that DO NOT HAVE "Mailing" in the sheet name
from all the files that DO NOT HAVE "Printing" in the file name
into one file ("C:\Zoltan\TEST.xlsx") keeping the sheets separate as they are in the source files
only if the sheet name already exist, I want to give it a date stamp (e.g. the sheet called "NTI UK (150)" from "E8795 NTI Mailing Order.XLSX" created on the 28th August 2105 to become "NTI UK (150) 20150828"
Below is as far as I got, which unfortunately doesn't seem to do anything. Currently I'm running the macro from the opened destination file (which is not much of an issue, I'm quite happy to have it that way). I'm also still missing the "Printing" exclusion (instead of the "Mailing" inclusion) in the FILE NAME and the whole date stamp bit, but those will be my next steps:
Sub CombineSheets()
Dim sPath As String
Dim sFname As String
Dim wbk As Workbook
Dim wSht As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = "C:\Zoltan\TEST\"
ChDir sPath
sFname = "*Mailing*"
sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)
Do Until sFname = ""
Set wbk = Workbooks.Open(sFname)
Windows(sFname).Activate
For Each ws In Sheets
If Not ws.Name Like "*Mailing*" Then ws.Copy Before:=ThisWorkbook.Sheets(1)
wbk.Close False
sFname = Dir()
Next
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I hope I've drawn up the problem in a clear and easy to understand way, but just to be on the safe side, if I did this manually it would be the following:
Open the TEST file
Open a source file that does not have the word
"Printing" in the file name
Highlight all the sheets that do not
have "Mailing" in the sheet name (these are just forms, not data
sheets, I don't need them)
Right click and "Move or Copy", tick
"Create a copy", select TEST.xlsx and select Sheet1
Close source file and move on to the next one
Please note, if the above is pure butchery, that is due to my lack of sufficient VBA skills. I tend to look at other people's codes, or record macros, take them apart and then try to make sense of them and put them back together the way I want them to work.
Where do I go wrong? Is there an easier way to code this? NB. I'd much rather copy entire sheets than highlighting ranges within sheets and place those ranges into new sheets in the destination file, like most codes (that I have come across) would do.
Many thankZ
Is your code creating a copy of the sheets you find? You're not explaining exactly what is, or is not, happening. You do have your sFname = Dir() command in the wrong place... And I suggest just automatically setting the names rather than trying to see if a name exists...
The filename is easy enough, use the following within your do loop:
Set wbk = Workbooks.Open(sFname)
Windows(sFname).Activate
For Each ws In Sheets
If Not sFname Like "*printing*" Then
If Not ws.Name Like "*Mailing*" Then
ws.Copy Before:=ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets(1).Name = ThisWorkbook.Sheets(1).Name + Format(Now(), "yyyyMMdd-hhmm")
End If
wbk.Close
End If
Next
sFname = Dir()
Some fixes:
Sub CombineSheets()
Const sPath As String = "C:\Zoltan\TEST\"
Dim sFname As String
Dim wbk As Workbook
Dim wSht As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
'sPath already has a trailing \ - don't add another...
sFname = Dir(sPath & "*Mailing*.xl*", vbNormal)
Do Until sFname = ""
'Dir only gives you the filename - use full path below
Set wbk = Workbooks.Open(sPath & sFname)
For Each wSht In wbk.WorkSheets
If Not wSht.Name Like "*Mailing*" Then
wSht.Copy Before:=ThisWorkbook.Sheets(1)
End If
Next
'moved these lines out of the sheets loop
wbk.Close False
sFname = Dir()
Loop
ThisWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The problem in question centers around one workbook which contains all of my data and breakdowns spread across a ton of worksheets. I'm trying to get macros set up to copy select sheets to a new workbook. I think my biggest problem is getting the coding right for the destination workbook since the name includes a date string that changes each day. The code that I've got so far to just create the new workbook and close it is:
Sub NewReport()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
MyDate = Date
Dim dateStr As String
dateStr = Format(MyDate, "MM-DD-YY")
Set W = Application.Workbooks.Add
W.SaveAs Filename:="N:\PAR\" & "New Report Name" & " " & dateStr, FileFormat:=51
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveWorkbook.Close True
End Sub
This works and does what I want in regards to creating the new document, naming it the way it should be named, and at the end closing it. What I need help with is that middle portion for copying specific sheets from the original workbook to this new one. What I was thinking was along the lines of:
With Workbooks("Original Workbook.xlsm")
.Sheets(Array("Sheet1", "Sheet2")).Copy_ Before:=Workbooks("destination.xls").Sheet1
Or at least some type of array to get exactly what I want to copy over. The biggest sticking point is getting the destination workbook path name correct. Any advice regarding individual pieces of this little project or on the whole is greatly appreciated. Thanks!
EDIT: I also need to point out that the new workbook being generated needs to be just plain old excel format (.xlsx). No macros, no security warning for automatic updating links or enabling macros, zip. Just a plain book of the sheets I tell it to put there.
Ok. I finally got it working now. Sheet names are carried over (otherwise I would have to go behind and rename them); it saves one copy to be sent and one copy to our archive folder; and the new workbooks don't get any popup about enabling macros or updating links. The code I finally settled on (which could probably be trimmed a little) is:
Sub Report()
Dim Wb1 As Workbook
Dim dateStr As String
Dim myDate As Date
Dim Links As Variant
Dim i As Integer
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set Wb1 = ActiveWorkbook
myDate = Date
dateStr = Format(myDate, "MM-DD-YYYY")
Wb1.Sheets(Array("Sheet1Name", "Sheet2Name", "etc."))Copy
With ActiveWorkbook
Links = .LinkSources(xlExcelLinks)
If Not IsEmpty(Links) Then
For i = 1 To UBound(Links)
.BreakLink Links(i), xlLinkTypeExcelLinks
Next i
End If
End With
ActiveWorkbook.SaveAs Filename:="N:\" & "Report Name" & " " & dateStr, FileFormat:=51
ActiveWorkbook.SaveAs Filename:="N:\Report Archive\" & "Report Name" & " " & dateStr, FileFormat:=51
ActiveWorkbook.Close
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub
Hope that'll help someone else with the same issue!
Your copy line should be
Workbooks("Original Workbook.xlsm").Sheets(Array("Sheet1", "Sheet2")).Copy _
Before:=W.Sheets(1)
You can make your code fully variable rather than harcoding "Orginal Workbook.xlsm" and the Sheet1 and Sheet2 names
If you use two Workbook variables then you can set the ActiveWorbook (ie the one currently selected in Excel) as the workbook to be copied (alternatively you can set it to a closed workbook, existing open named workbook, or the workbook that contains the code).
With a standard
Application.Workbooks.Add
you will get a new workbook with the number of sheets installed as per your default option (normnally 3 sheets)
By specifying
Application.Workbooks.Add(1)
a new workbook is created with only one sheet
And note I disabled macros by setting EnableEvents to False but it would be unusual to have application events running when creating workbooks
Then when copying the sheet use
Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy
'rather than
Sheets(Array("Sheet1", "Sheet2")).Copy
to avoid hardcoding the sheet names to be copied. This code will copy the two leftmoast sheets irrespective of naming
Lastly the initial single sheet is removed leaving you with a new file with only the two copied sheets inside
Sub NewReport()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim dateStr As String
Dim myDate As Date
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set Wb1 = ActiveWorkbook
myDate = Date
dateStr = Format(myDate, "MM-DD-YY")
Set Wb2 = Application.Workbooks.Add(1)
Wb1.Sheets(Array(Wb1.Sheets(1).Name, Wb1.Sheets(2).Name)).Copy Before:=Wb2.Sheets(1)
Wb2.Sheets(Wb2.Sheets.Count).Delete
Wb2.SaveAs Filename:="c:\test\" & "New Report Name" & " " & dateStr, FileFormat:=51
Wb2.Close
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
End Sub