Sub csv()
Dim Fs, myFile As Object
Dim myfileline As String 'txtfile的行数据
Dim sht As Worksheet
Dim csvFileName As String 'csv文件名
Dim totalRows As Integer ' 总的行数
Dim totalColumns As Integer '总的列数
Dim sheetNumber As Integer '工作表号
Dim strAll As String '整个工作表的文本
csvFileName = InputBox("请输入文件名:", "CSV", "export_csv")
totalRows = 17 ' 总的行数
totalColumns = 10 '总的列数
sheetNumber = 1 '工作表号
For Each sht In ThisWorkbook.Sheets
Set Fs = CreateObject("Scripting.FileSystemObject") '建立filesytemobject
Set myFile = Fs.createtextfile(ActiveWorkbook.Path & "\" + csvFileName & "_Sheet" + CStr(sheetNumber) + ".csv") '通过filesystemobject新建一个csv文件
For i = 1 To totalRows '从第1行开始
ra = CStr(sht.Cells(i, 1).Value) '从第一列开始
If ra = "" Then Exit For
rb = ""
For j = 1 To 10
ca = CStr(sht.Cells(1, j).Value)
If ca = "" Then Exit For
If rb = "" Then
rb = CStr(sht.Cells(i, j).Value)
Else
rb = rb & "," & CStr(sht.Cells(i, j).Value)
End If
Next j
myFile.writeline (rb)
strAll = strAll + rb + vbCrLf
Next i
Set myFile = Nothing
Set Fs = Nothing '关闭文件和filesystemobject对象
SaveSetting AppName:="MyApp201912", Section:="MySection", Key:="Sheet" & CStr(sheetNumber), Setting:=strAll '保存所有文本到注册表
sheetNumber = sheetNumber + 1 '下一个工作表
Next
MsgBox ("已保存了" + CStr(sheetNumber - 1) + "个CSV文件!")
MsgBox "已保存工作表内容到注册表:HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApp201912\MySection"
End Sub