有没有办法导出和Excel工作表，而不复制到工作簿？

我有一个工作簿，可以将工作表导出到.csv，但它复制到一个新的工作簿一秒钟之前保存即时通讯想知道是否有一种方法只是复制工作表中的数据，而不需要打开一个新的工作簿？ 我有的代码是：

Sub CopyToCSV() Dim FlSv As Variant Dim MyFile As String Dim sh As Worksheet Dim MyFileName As String Dim DateString As String Application.ScreenUpdating = False DateString = Format(Now(), "dd-mm-yyyy_hh-mm-ss-AM/PM") '<~~ uses current time from computer clock down to the second MyFileName = "Results - " & DateString Set sh = Sheets("Sheet1") sh.Copy FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?") If FlSv = False Then GoTo UserCancel Else GoTo UserOK UserCancel: '<~~ this code is run if the user cancels out the file save dialog ActiveWorkbook.Close (False) MsgBox "Export Canceled" Exit Sub UserOK: '<~~ this code is run if user proceeds with saving the file (clicks the OK button) MyFile = FlSv With ActiveWorkbook .SaveAs (MyFile), FileFormat:=xlCSV, CreateBackup:=False .Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

Answer 1

试试这个（ 在一个简单的数据集上testing ）

 Private Sub ExportToCsv() Dim ws As Worksheet Dim delim As String, LastCol As String, csvFile As String, CsvLine As String Dim aCell As Range, DataRange As Range Dim ff As Long, lRow As Long, lCol As Long Dim i As Long, j As Long '~~> We use "," as delimiter delim = "," '~~> Change this to specify your file name and path csvFile = "C:\Users\Siddharth\Desktop\Sample.Csv" '~~> Change this to the sheet which you want to export as csv Set ws = ThisWorkbook.Sheets("Sheet9") With ws '~~> Find last row and last column lRow = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row lCol = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column '~~> Column number to column letter LastCol = Split(Cells(, lCol).Address, "$")(1) '~~> This is the range which will be exported Set DataRange = .Range("A1:" & LastCol & lCol) ' '~~> Loop through cells in the range and write to text file ' ff = FreeFile Open csvFile For Output As #ff For i = 1 To lRow For j = 1 To lCol CsvLine = CsvLine & (delim & Replace(.Cells(i, j).Value, """", """""""")) Next j Print #ff, Mid(CsvLine, 2) CsvLine = "" Next '~~> Close text file Close #ff End With End Sub 

Answer 2

 Sub CopyToCSV() Dim FlSv As Variant Dim MyFile As String Dim sh As Worksheet Dim MyFileName As String Dim strTxt As String Dim vDB, vR() As String, vTxt() Dim i As Long, n As Long, j As Integer Dim objStream Dim strFile As String Application.ScreenUpdating = False DateString = Format(Now(), "dd-mm-yyyy_hh-mm-ss-AM/PM") '<~~ uses current time from computer clock down to the second MyFileName = "Results - " & DateString FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?") If FlSv = False Then GoTo UserCancel Else GoTo UserOK UserCancel: '<~~ this code is run if the user cancels out the file save dialog ActiveWorkbook.Close (False) MsgBox "Export Canceled" Exit Sub UserOK: '<~~ this code is run if user proceeds with saving the file (clicks the OK button) Set objStream = CreateObject("ADODB.Stream") MyFile = FlSv vDB = ActiveSheet.UsedRange For i = 1 To UBound(vDB, 1) n = n + 1 ReDim vR(1 To UBound(vDB, 2)) For j = 1 To UBound(vDB, 2) vR(j) = vDB(i, j) Next j ReDim Preserve vTxt(1 To n) vTxt(n) = Join(vR, ",") Next i strtxt = Join(vTxt, vbCrLf) With objStream .Charset = "utf-8" .Open .WriteText strtxt .SaveToFile FlSv, 2 .Close End With Set objStream = Nothing Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub