Export multiple sheets to 1 csv file.

Didn't that macro do it all within excel?





Mark Bath wrote:
>
> 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" <ec35720@netscapeXSPAM.com> wrote in message
> news:41E5E02C.6FDC27EC@netscapeXSPAM.com...
> > 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 wrote:
> > >
> > > 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

--

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>>