时间戳

首页 > 解决方案 > VBA 将工作表另存为 CSV 会破坏现有模块

excel - VBA 将工作表另存为 CSV 会破坏现有模块

问题描述

我正在尝试构建一个 VBA 子程序，它将复制工作表并将其保存为 CSV。我正在使用经过验证的真实方法：

1) 复制工作表

2) 打开一个新的工作簿

3）将复制的数据粘贴到该新工作簿中

4) 将该工作簿保存为 CSV

源表在两个单元格中包含几个公式和一个模块，所以我打算使用.PasteSpecial xlPasteValues. 但是，运行子程序会引发错误 1004 并破坏源工作表中的模块（然后它们显示为 #VALUE）。

我尝试单步执行子程序，问题似乎.PasteSpecial出在源表中的方法/东西上。当我得到这.PasteSpecial一步时，源表中包含的模块启动，然后我陷入了一个循环。

作为旁注，该Set csvFileName行指的是在运行子之前连接文件名值的单元格。我不认为这是导致问题的原因，因为我删除了它并看到了相同的行为。

这是代码：

Sub SaveAsCSV()

    Dim csvFileName As String
    Dim ThisWB As Workbook, csvWB As Workbook

    Set ThisWB = ActiveWorkbook

    ThisWB.Sheets("SourceSheet").UsedRange.Copy

    Set csvWB = Application.Workbooks.Add(1)

    csvWB.Sheets(1).Range("A1").PasteSpecial xlPasteValues

    Set csvFileName = ThisWB.Path & "\" & ThisWB.Sheets("Instructions").Range("E10").Value & ".csv"

    Application.DisplayAlerts = False
    csvWB.SaveAs FileName:=csvFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    csvWB.Close SaveChanges:=False
    Application.DisplayAlerts = True

    MsgBox "File has been Created and Saved"

End Sub

还有一些注意事项：

任何帮助将不胜感激！！

编辑：5-23-19

作为参考，这里是模块代码：

Function MultipleLookupNoRept(Lookupvalue As String, LookupRange As Range, ColumnNumber As Integer)

Dim i As Long
Dim Result As String

For i = 1 To LookupRange.Columns(1).Cells.Count
  If LookupRange.Cells(i, 1) = Lookupvalue Then
    For J = 1 To i - 1
    If LookupRange.Cells(J, 1) = Lookupvalue Then
      If LookupRange.Cells(J, ColumnNumber) = LookupRange.Cells(i, ColumnNumber) Then
        GoTo Skip
      End If
    End If
    Next J
    Result = Result & " " & LookupRange.Cells(i, ColumnNumber) & ","
Skip:
  End If
Next i

MultipleLookupNoRept = Left(Result, Len(Result) - 1)

End Function

标签： excelvbamodule

解决方案

试试这个（没有复制/粘贴）：

Sub SaveAsCSV()

    Dim csvFileName As String
    Dim ThisWB As Workbook, csvWB As Workbook, rngUsed As Range

    Set ThisWB = ActiveWorkbook

    Set rngUsed = ThisWB.Sheets("SourceSheet").UsedRange

    csvFileName = ThisWB.Path & "\" & _
           ThisWB.Sheets("Instructions").Range("E10").Value & ".csv" 'no Set!

    Application.DisplayAlerts = False

    With Application.Workbooks.Add(1)
        .Sheets(1).Range("A1").Resize(rngUsed.Rows.Count, _
                           rngUsed.Columns.Count).Value = rngUsed.Value

        .SaveAs Filename:=csvFileName, FileFormat:=xlCSV, _
                          CreateBackup:=False, Local:=True

        .Close SaveChanges:=False
    End With

    Application.DisplayAlerts = True

    MsgBox "File has been Created and Saved"

End Sub

推荐阅读