phio3nix
11-21-2011, 01:07 AM
hello there. i'm new with vba programming that's why i joined this forum. while i'm browsing your page, it seems that people here are too great and active because users here can easily solve the problems of their users. hope that you can help me too. :)
i'm having problem in exporting data of excel to csv. the excel have multiple sheets and each sheet have different content. different content because each sheet have different number of header and number of rows and columns. i fount the code of Mr. kenneth hobs in "vbaexpress.com/forum/showthread.php?t=24668&highlight=CreateCSVFromXLSsheets" Attribute VB_Name = "Module1"
Sub CreateCSVFromXLSsheets()
Dim xlsheet As Excel.Worksheet
Dim xlbook As Excel.Workbook
Dim r As Excel.Range, r2 As Excel.Range
Dim sht As Excel.Worksheet
Dim nr As Long
Dim csvPathName As String
csvPathName = ActiveWorkbook.path & "\Test.csv"
On Error GoTo theEnd
SpeedOn
Application.ScreenUpdating = False
Set xlbook = Application.Workbooks.Add
Set xlsheet = xlbook.Worksheets.Add
xlsheet.Name = "CSV"
For Each sht In ThisWorkbook.Worksheets
nr = LastNBRow(xlsheet.UsedRange) + 1
Set r = xlsheet.Range("A" & nr)
Set r2 = ThisWorkbook.Worksheets(sht.Name).Range(RangeLR1(sht.UsedRange).Address)
r.Resize(r2.Rows.Count, r2.Columns.Count).Value = r2.Value
Next sht
On Error Resume Next
'Delete old csv file if it exists
Kill csvPathName
On Error GoTo theEnd
xlbook.SaveAs Filename:=csvPathName, FileFormat:=xlCSV, CreateBackup:=False
'ActiveSheet.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV
xlbook.Close False
theEnd:
On Error Resume Next
Set xlsheet = Nothing
Set xlbook = Nothing
SpeedOff
'Open csv file to see if it was created ok.
'Shell "cmd /c " & """" & csvPathName & """"
End Sub
'=LastNBRow(A3:G10)
Function LastNBRow(rng As Range) As Long
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = rng.Find(What:="*", After:=rng.Cells(rng.Rows.Count, rng.Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
LastNBRow = LastRow
End Function
Function RangeLR1(aRange As Range) As Range
Set RangeLR1 = Range(Cells(aRange.Row + 1, aRange.Column), Cells(aRange.Rows.Count, aRange.Columns.Count))
End Function
End Sub
the code works but it is not suit with my problem because the code exports data to csv but each sheet have same content. it is hard for me to reconstruct his code coz i'm newbie in vba programming. I hope you can help me.
Requirements:
1. exporting excel data to one csv file.
2. all data should be enclose in double quotations (")
3. blank cell should output dash ("-")
4. data with enter should be replace by <br />
5. the csv filename should be the xls filename
6. headers on top should not be included in the exported csv file
7. Delimiter is comma (,)
Base on my understanding, this requirements is too hard because i've been 1 week searching for my problem in google but i cant find the solution for my problem. but i think when i post my problem here, you can solve my problem. :) hope you can help me guys with this issue. thanks.
i'm having problem in exporting data of excel to csv. the excel have multiple sheets and each sheet have different content. different content because each sheet have different number of header and number of rows and columns. i fount the code of Mr. kenneth hobs in "vbaexpress.com/forum/showthread.php?t=24668&highlight=CreateCSVFromXLSsheets" Attribute VB_Name = "Module1"
Sub CreateCSVFromXLSsheets()
Dim xlsheet As Excel.Worksheet
Dim xlbook As Excel.Workbook
Dim r As Excel.Range, r2 As Excel.Range
Dim sht As Excel.Worksheet
Dim nr As Long
Dim csvPathName As String
csvPathName = ActiveWorkbook.path & "\Test.csv"
On Error GoTo theEnd
SpeedOn
Application.ScreenUpdating = False
Set xlbook = Application.Workbooks.Add
Set xlsheet = xlbook.Worksheets.Add
xlsheet.Name = "CSV"
For Each sht In ThisWorkbook.Worksheets
nr = LastNBRow(xlsheet.UsedRange) + 1
Set r = xlsheet.Range("A" & nr)
Set r2 = ThisWorkbook.Worksheets(sht.Name).Range(RangeLR1(sht.UsedRange).Address)
r.Resize(r2.Rows.Count, r2.Columns.Count).Value = r2.Value
Next sht
On Error Resume Next
'Delete old csv file if it exists
Kill csvPathName
On Error GoTo theEnd
xlbook.SaveAs Filename:=csvPathName, FileFormat:=xlCSV, CreateBackup:=False
'ActiveSheet.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV
xlbook.Close False
theEnd:
On Error Resume Next
Set xlsheet = Nothing
Set xlbook = Nothing
SpeedOff
'Open csv file to see if it was created ok.
'Shell "cmd /c " & """" & csvPathName & """"
End Sub
'=LastNBRow(A3:G10)
Function LastNBRow(rng As Range) As Long
Dim LastRow As Long
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = rng.Find(What:="*", After:=rng.Cells(rng.Rows.Count, rng.Columns.Count), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If
LastNBRow = LastRow
End Function
Function RangeLR1(aRange As Range) As Range
Set RangeLR1 = Range(Cells(aRange.Row + 1, aRange.Column), Cells(aRange.Rows.Count, aRange.Columns.Count))
End Function
End Sub
the code works but it is not suit with my problem because the code exports data to csv but each sheet have same content. it is hard for me to reconstruct his code coz i'm newbie in vba programming. I hope you can help me.
Requirements:
1. exporting excel data to one csv file.
2. all data should be enclose in double quotations (")
3. blank cell should output dash ("-")
4. data with enter should be replace by <br />
5. the csv filename should be the xls filename
6. headers on top should not be included in the exported csv file
7. Delimiter is comma (,)
Base on my understanding, this requirements is too hard because i've been 1 week searching for my problem in google but i cant find the solution for my problem. but i think when i post my problem here, you can solve my problem. :) hope you can help me guys with this issue. thanks.