Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 one
2 two
3 three

Sheet2
4 four
5 five
6 sixe


I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive


Thanks
Chen

Chen,

See if this does about what you want.

The line
strCSVpath = "C:\Test\myExport.csv"
needs to be edited to the path and file name you want for the csv file (make
sure the path exists)

'---------------------------------------
Sub MultiSheetCSVexport()

Const ForWriting = 2

Dim myRange As Range
Dim strCSVpath As String
Dim FSO, objTxtFile

strCSVpath = "C:\Test\myExport.csv"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objTxtFile = FSO.OpenTextFile(strCSVpath, ForWriting, True)

For Each wkSheet In Application.Worksheets
Set myRange = wkSheet.UsedRange
With wkSheet
If myRange.Rows.Count 2 Then
For R = 1 To myRange.Rows.Count
If myRange.Columns.Count 1 Then
For C = 1 To myRange.Columns.Count - 1
objTxtFile.Write .Cells(R, C).Text & ","
Next C
objTxtFile.Write .Cells(R, myRange.Columns.Count).Text &
vbCrLf
Else
objTxtFile.Write .Cells(R, 1).Text & vbCrLf
End If
Next R
Else
If myRange.Columns.Count 1 Then
For C = 1 To myRange.Columns.Count - 1
objTxtFile.Write .Cells(1, C).Text & ","
Next C
objTxtFile.Write .Cells(1, myRange.Columns.Count).Text & vbCrLf
Else
objTxtFile.Write .Cells(1, 1).Text & vbCrLf
End If
End If
End With
Next wkSheet

objTxtFile.Close
Set objTxtFile = Nothing
Set FSO = Nothing

End Sub


'---------------------------------------

Steve Yandl



"cyew" wrote in message
...
Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 one
2 two
3 three

Sheet2
4 four
5 five
6 sixe


I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive


Thanks
Chen

Something like this should work:

Sub test()

Dim LR As Long
Dim oSheet As Worksheet
Dim hFile As Long
Dim strFile As String
Dim bOpenFile As Boolean
Dim arr

strFile = "C:\test.csv"

bOpenFile = True

For Each oSheet In ActiveWorkbook.Sheets
With oSheet
LR = .Cells(65536, 1).End(xlUp).Row
If Not IsEmpty(Cells(LR, 1)) Then
arr = Range(Cells(1), Cells(LR, 2))
SaveArrayToTextAppend strFile, arr, hFile, bOpenFile, False
bOpenFile = False
End If
End With
Next oSheet

Close #hFile

End Sub

Sub SaveArrayToTextAppend(strFile As String, _
arr As Variant, _
hFile As Long, _
Optional bOpenFile As Boolean = True, _
Optional bCloseFile As Boolean = True, _
Optional ByVal LBRow As Long = -1, _
Optional ByVal UBRow As Long = -1, _
Optional ByVal LBCol As Long = -1, _
Optional ByVal UBCol As Long = -1)

Dim r As Long
Dim c As Long

If LBRow = -1 Then
LBRow = LBound(arr, 1)
End If

If UBRow = -1 Then
UBRow = UBound(arr, 1)
End If

If LBCol = -1 Then
LBCol = LBound(arr, 2)
End If

If UBCol = -1 Then
UBCol = UBound(arr, 2)
End If

If bOpenFile Then
hFile = FreeFile
Open strFile For Append As #hFile
End If

For r = LBRow To UBRow
For c = LBCol To UBCol
If c = UBCol Then
Write #hFile, arr(r, c)
Else
Write #hFile, arr(r, c);
End If
Next c
Next r

If bCloseFile Then
Close #hFile
End If

End Sub


RBS



"cyew" wrote in message
...
Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 one
2 two
3 three

Sheet2
4 four
5 five
6 sixe


I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive


Thanks
Chen

Chen,

On review of how this printed in my post, note that the following should all
be on a single line:

objTxtFile.Write .Cells(R, myRange.Columns.Count).Text &
vbCrLf

It got pushed to two lines in the post and won't work that way.

should be,
objTxtFile.Write.Cells(R, myRange.Columns.Count).Text & vbCrLf


Steve Yandl



"Steve Yandl" wrote in message
...
Chen,

See if this does about what you want.

The line
strCSVpath = "C:\Test\myExport.csv"
needs to be edited to the path and file name you want for the csv file
(make sure the path exists)

'---------------------------------------
Sub MultiSheetCSVexport()

Const ForWriting = 2

Dim myRange As Range
Dim strCSVpath As String
Dim FSO, objTxtFile

strCSVpath = "C:\Test\myExport.csv"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set objTxtFile = FSO.OpenTextFile(strCSVpath, ForWriting, True)

For Each wkSheet In Application.Worksheets
Set myRange = wkSheet.UsedRange
With wkSheet
If myRange.Rows.Count 2 Then
For R = 1 To myRange.Rows.Count
If myRange.Columns.Count 1 Then
For C = 1 To myRange.Columns.Count - 1
objTxtFile.Write .Cells(R, C).Text & ","
Next C
objTxtFile.Write .Cells(R, myRange.Columns.Count).Text &
vbCrLf
Else
objTxtFile.Write .Cells(R, 1).Text & vbCrLf
End If
Next R
Else
If myRange.Columns.Count 1 Then
For C = 1 To myRange.Columns.Count - 1
objTxtFile.Write .Cells(1, C).Text & ","
Next C
objTxtFile.Write .Cells(1, myRange.Columns.Count).Text & vbCrLf
Else
objTxtFile.Write .Cells(1, 1).Text & vbCrLf
End If
End If
End With
Next wkSheet

objTxtFile.Close
Set objTxtFile = Nothing
Set FSO = Nothing

End Sub


'---------------------------------------

Steve Yandl



"cyew" wrote in message
...
Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 one
2 two
3 three

Sheet2
4 four
5 five
6 sixe


I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive


Thanks
Chen

One way, but not so fast.
If your workbook's name is Book1.xls, this macro would create a file
named Book1.csv in the same folder with Book1.xls

Sub Worbook2Csv()
Dim Csvname As String, Pdir As String
Dim TmpWB As Workbook, AcWB As Workbook
Dim Fname() As String
Dim SelSh As Sheets, Wsh As Worksheet
Dim filenum
Dim i As Long

Pdir = ActiveWorkbook.path
Csvname = ActiveWorkbook.Name
Csvname = Left(Csvname, InStr(Csvname, ".") - 1)
ChDir Pdir
Set AcWB = ActiveWorkbook
Set SelSh = AcWB.Worksheets

SelSh.Copy
Set TmpWB = ActiveWorkbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

ReDim Fname(TmpWB.Worksheets.Count - 1)

For Each Wsh In TmpWB.Worksheets
Wsh.Select
TmpWB.SaveAs Filename:=Csvname & "Tmp" & CStr(i), _
FileFormat:=xlCSV, CreateBackup:=False
Fname(i) = TmpWB.FullName
i = i + 1
Next
TmpWB.Close

Open Fname(0) For Append As #1
For i = 1 To UBound(Fname)
filenum = FreeFile
Open Fname(i) For Input As #filenum
Do While Not EOF(filenum)
Line Input #filenum, tmp
Print #1, tmp
Loop
Close #filenum
Kill Fname(i)
Next
Close #1

Name Fname(0) As Replace(Fname(0), "Tmp0", "")

Keiji

cyew wrote:
Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 one
2 two
3 three

Sheet2
4 four
5 five
6 sixe


I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive


Thanks
Chen

On 19 Oct, 10:56, keiji kounoike <"kounoike A | T ma.Pikara.ne.jp"
wrote:
One way, but not so fast.
If your workbook's name is Book1.xls, this macro would create a file
named Book1.csv in the same folder with Book1.xls

Sub Worbook2Csv()
Dim Csvname As String, Pdir As String
Dim TmpWB As Workbook, AcWB As Workbook
Dim Fname() As String
Dim SelSh As Sheets, Wsh As Worksheet
Dim filenum
Dim i As Long

Pdir = ActiveWorkbook.path
Csvname = ActiveWorkbook.Name
Csvname = Left(Csvname, InStr(Csvname, ".") - 1)
ChDir Pdir
Set AcWB = ActiveWorkbook
Set SelSh = AcWB.Worksheets

SelSh.Copy
Set TmpWB = ActiveWorkbook

Application.DisplayAlerts = False
Application.ScreenUpdating = False

ReDim Fname(TmpWB.Worksheets.Count - 1)

For Each Wsh In TmpWB.Worksheets
* * *Wsh.Select
* * *TmpWB.SaveAs Filename:=Csvname & "Tmp" & CStr(i), _
* * * * *FileFormat:=xlCSV, CreateBackup:=False
* * *Fname(i) = TmpWB.FullName
* * *i = i + 1
Next
TmpWB.Close

Open Fname(0) For Append As #1
For i = 1 To UBound(Fname)
* * *filenum = FreeFile
* * *Open Fname(i) For Input As #filenum
* * *Do While Not EOF(filenum)
* * * * *Line Input #filenum, tmp
* * * * *Print #1, tmp
* * *Loop
* * *Close #filenum
* * *Kill Fname(i)
Next
Close #1

Name Fname(0) As Replace(Fname(0), "Tmp0", "")

Keiji

cyew wrote:
Hi

I am new to VBA.

I have data on a number of sheets and I would like to write VBA codes
to loop through each sheet and write out the data in one CSV file.

eg

Sheet1
1 *one
2 *two
3 *three

Sheet2
4 *four
5 *five
6 *sixe

I would like my output CSV file to be:
1,one
2,two
3,three
4,four
5,five
6,sive

Thanks
Chen



Thanks All for your help.

Chen