从 xlsm 复制并粘贴到 csv

Posted 2023-04-13

【中文标题】从 xlsm 复制并粘贴到 csv

【英文标题】：copy and paste from xlsm to csv

【发布时间】：2021-07-31 22:09:43

【问题描述】：

我正在尝试从启用宏的工作簿复制到 .csv 文件，但由于某种原因，粘贴部分仅将所有内容粘贴到 A 列中。 VBA编码如下。请帮我弄清楚为什么它不会粘贴到它复制的相同单元格中。当我逐步运行宏时，它可以完美运行，但是当它自己运行时，它会将所有数据粘贴到 A 列中。

Sheets("Input").Select

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Workbooks.Open Filename:="C:\temp\MyFile.csv"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False

【参考方案1】：

将工作表导出为 CSV

另一种选择

如果您尝试选择的任何内容都是工作表中的唯一数据，您可以只使用copy the worksheet，这将创建一个仅包含此工作表的新工作簿，最后将其保存为 CSV 文件。

Option Explicit

Sub ExportWorksheetToCSVtest()
    Const FilePath As String = "C:\temp\MyFile.csv"
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Input")
    ExportWorksheetToCSV ws, FilePath
End Sub

Sub ExportWorksheetToCSV( _
        ByVal ws As Worksheet, _
        ByVal FilePath As String)
    If ws Is Nothing Then Exit Sub
    
    ws.Copy
    With ActiveWorkbook
        Application.DisplayAlerts = False
        .SaveAs FilePath, xlCSV
        Application.DisplayAlerts = True
        .Close SaveChanges:=False
    End With
End Sub
    

【参考方案2】：

更新了改进的答案。

不确定您的工作表有什么问题，但这会起作用。不要使用选择。

Dim CopyRange As Range, copySheet As Worksheet
Set copySheet = ActiveSheet

Set CopyRange = Intersect(Range("A:C"), copySheet.UsedRange)

Dim theValues()

theValues = CopyRange.Value

Workbooks.Open Filename:="C:\temp\MyFile.csv"
Dim theCSV As Workbook
    Set theCSV = ActiveWorkbook
theCSV.Sheets(1).Range("A1").Resize(UBound(theValues), UBound(theValues, 2)) = theValues

【参考方案3】：

@PGSystemTester：这段代码做了同样的事情。所有内容都仅粘贴在 A 列中。

@VBasic2008：这有效，但也出现了意外错误。

我所做的就是运行两次相同的宏。我不确定为什么会这样。但是宏第一次运行时，它会将所有内容粘贴到 A 列中。再次运行时，它会正确粘贴。所以我只是将宏的编码加倍，现在它可以正常工作了。

感谢您的帮助！