这里有很多关于如何创建一个宏来将工作表保存为CSV文件的问题。所有答案都使用了SaveAs，例如从SuperUser网站中的这个回答。它们基本上是建议创建一个如下的VBA函数：
Sub SaveAsCSV()
ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub
有可能只导出当前工作表作为文件，但继续在我的原始文件中工作吗？
@NathanClement 更快一些。不过这里是完整的代码（略微更为详细）：
Option Explicit
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("Sheet1") 'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
FileFormat:=xlCSVUTF8。 - undefined这几乎是我想要的 @Ralph，但是这里是最佳答案，因为它解决了您代码中的一些烦恼：
为了解决这些问题并满足我的所有需求，我改编了这里的代码。我对其进行了清理以使其更易读。
Option Explicit
Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
请注意上面代码的一些特点：
- 5更改为- 4。编辑：添加Local:=True以保存带有本地CSV分隔符的文件。
Workbook.Close的正确方式。 - KuNWith TempWB.Sheets(1).Range("A1") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats End With - Craig LambieSub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
'Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
这里针对上面的答案进行了一些小改进，同时在同一程序中处理 .xlsx 和 .xls 文件，希望能对某些人有所帮助！
我还添加了一行代码，以选择使用活动表格的名称保存而不是工作簿名称，这对我来说很实用：
Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, InStrRev(CurrentWB.Name, ".") - 1) & ".csv"
'Optionally, comment previous line and uncomment next one to save as the current sheet name
'MyFileName = CurrentWB.Path & "\" & CurrentWB.ActiveSheet.Name & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
对于那些需要更多输出定制（分隔符或十进制符号）或者拥有大型数据集（超过65k行）的情况，我编写了以下内容：
Option Explicit
Sub rng2csv(rng As Range, fileName As String, Optional sep As String = ";", Optional decimalSign As String)
'export range data to a CSV file, allowing to chose the separator and decimal symbol
'can export using rng number formatting!
'by Patrick Honorez --- www.idevlop.com
Dim f As Integer, i As Long, c As Long, r
Dim ar, rowAr, sOut As String
Dim replaceDecimal As Boolean, oldDec As String
Dim a As Application: Set a = Application
ar = rng
f = FreeFile()
Open fileName For Output As #f
oldDec = Format(0, ".") 'current client's decimal symbol
replaceDecimal = (decimalSign <> "") And (decimalSign <> oldDec)
For Each r In rng.Rows
rowAr = a.Transpose(a.Transpose(r.Value))
If replaceDecimal Then
For c = 1 To UBound(rowAr)
'use isnumber() to avoid cells with numbers formatted as strings
If a.IsNumber(rowAr(c)) Then
'uncomment the next 3 lines to export numbers using source number formatting
' If r.cells(1, c).NumberFormat <> "General" Then
' rowAr(c) = Format$(rowAr(c), r.cells(1, c).NumberFormat)
' End If
rowAr(c) = Replace(rowAr(c), oldDec, decimalSign, 1, 1)
End If
Next c
End If
sOut = Join(rowAr, sep)
Print #f, sOut
Next r
Close #f
End Sub
Sub export()
Debug.Print Now, "Start export"
rng2csv shOutput.Range("a1").CurrentRegion, RemoveExt(ThisWorkbook.FullName) & ".csv", ";", "."
Debug.Print Now, "Export done"
End Sub
wsToExport.Move
With Workbooks
Set wbCsv = .Item(.Count)
End With
Application.DisplayAlerts = False
wbCsv.SaveAs xlCSV
wbCsv.Close False
Application.DisplayAlerts = True
正如我所评论的，这个网站上有一些地方将工作表的内容写入CSV文件。 这个 和 那个 就是其中之二。
以下是我的版本
UsedRange - 因为您想获取工作表中的所有内容代码...
Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long
myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile
myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
outStr = ""
For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
Else
outStr = outStr & myArr(iLoop, jLoop) & ","
End If
Next jLoop
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
Else
outStr = outStr & myArr(iLoop, UBound(myArr, 2))
End If
Print #iFile, outStr
Next iLoop
Close iFile
Erase myArr
End Sub