Export multiple sheets to 1 csv file.

[Mark Bath]

Does anyone have a function I could use to export multiple worksheets (each
contains around 65000 lines) into 1 CSV file?
I have the following script which does a unique file for each worksheet, but
I'm lousy with VB programming and hopeing someone out there already has a
function or can help me edit this one.
And ideally I want to miss out the first 2 sheets from the export.

Thanks.
-----------------------------
Option Explicit
Sub mysaver()
Dim counter As Integer
counter = 1
' counter is for the number of sheets in the workbook
Do While counter <= Worksheets.Count
' Worksheets.Count represents the total number of sheets in the workbook
On Error GoTo ErrorHandler
' go to the nominated sheet
Worksheets(counter).Activate
' and save it. Simple...
ActiveSheet.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV
counter = counter + 1
Loop
MsgBox "All Sheets Saved.", , "Success"
Exit Sub

ErrorHandler:
MsgBox "Error during save - Caution!", vbCritical, "Save Errors"
Exit Sub
End Sub
-----------------------------

 

[Dave Peterson]

First, I'd save all the .csv files into a dedicated folder to keep them
separate.

Then I would shell to a command prompt and issue an old DOS command.

(change to that folder first)

copy /b *.csv all.txt
maybe even:
del *.csv
(if I was positive that it worked ok)
then
ren all.txt all.csv

In code:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim newWks As Worksheet
Dim myTempFolder As String
Dim myFileName As String
Dim iCtr As Long

myTempFolder = "C:\" & Format(Now, "yyyymmdd_hhmmss")

On Error Resume Next
MkDir myTempFolder
If Err.Number <> 0 Then
MsgBox "oh, oh"
Exit Sub
End If

iCtr = 0
For Each wks In ActiveWorkbook.Worksheets
Select Case LCase(wks.Name)
Case Is = "sheet1", "sheet2" 'do nothing
Case Else
wks.Copy 'copies to a new workbook
With ActiveSheet
iCtr = iCtr + 1
myFileName = myTempFolder & "\" & Format(iCtr, "000000")
.Parent.SaveAs Filename:=myFileName, _
FileFormat:=xlCSV
.Parent.Close savechanges:=False
End With
End Select
Next wks

Shell Environ("comspec") & " /k copy /b " & myTempFolder & "\*.csv " _
& myTempFolder & "\All.txt", vbNormalFocus
'/k keeps the DOS window open (nice for testing)
'/c closes the DOS window

Application.Wait Time:=Now + Time(0, 0, 5)
'a little time for the copy command to finish

Name myTempFolder & "\all.txt" As myTempFolder & "\all.csv"

End Sub

I didn't delete all the little ######.csv files. I like to see them to verify
that the routine worked ok. (And it's not to difficult to clean those up in
windows explorer (sort by name, click on first, ctrl-click on last, and hit the
delete key.)

And I like using the worksheet's name to determine which should be avoided.

If the copy command takes too much time, increase that time(0,0,5) to a little
more.

 

[Mark Bath]

Dave,
Cheers for the reply.
I was hoping for a way of doing it purely within Excel itself. This
spreadsheet needs to go out to various users, so I dont want to have to give
them all a set of instructions to do this
I ideally just want a button on the spreadsheet that will do it all for
them.

Any suggestions are welcome.

-M.

 

[Dave Peterson]

Didn't that macro do it all within excel?

Dave,
Cheers for the reply.
I was hoping for a way of doing it purely within Excel itself. This
spreadsheet needs to go out to various users, so I dont want to have to give
them all a set of instructions to do this
I ideally just want a button on the spreadsheet that will do it all for
them.

Any suggestions are welcome.

-M.

 

[Dave Peterson]

The only portion that doesn't work within excel is the clean up.

I like to verify first, but if you want that cleaned up:

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim newWks As Worksheet
Dim myTempFolder As String
Dim myFileName As String
Dim iCtr As Long

'Dim FSO As Scripting.FileSystemObject
Dim FSO As Object

'Set FSO = New Scripting.FileSystemObject
Set FSO = CreateObject("scripting.filesystemobject")

myTempFolder = "C:\" & Format(Now, "yyyymmdd_hhmmss")

On Error Resume Next
MkDir myTempFolder
If Err.Number <> 0 Then
MsgBox "oh, oh"
Exit Sub
End If

iCtr = 0
For Each wks In ActiveWorkbook.Worksheets
Select Case LCase(wks.Name)
Case Is = "sheet1", "sheet2" 'do nothing
Case Else
wks.Copy 'copies to a new workbook
With ActiveSheet
iCtr = iCtr + 1
myFileName = myTempFolder & "\" & Format(iCtr, "000000")
.Parent.SaveAs Filename:=myFileName, _
FileFormat:=xlCSV
.Parent.Close savechanges:=False
End With
End Select
Next wks

Shell Environ("comspec") & " /k copy /b " & myTempFolder & "\*.csv " _
& myTempFolder & "\All.txt", vbNormalFocus
'/k keeps the DOS window open (nice for testing)
'/c closes the DOS window

Application.Wait Time:=Now + Time(0, 0, 5)
'a little time for the copy command to finish

FSO.DeleteFile filespec:=myTempFolder & "\*.csv"

Name myTempFolder & "\all.txt" As myTempFolder & "\all.csv"

End Sub

<<snipped>>