Question

我正在尝试构建一个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

更多注意事项：

在我运行SaveAsCSV子模块之前，该模块可以正常工作。
该模块保存在工作簿级别。它基本上是一个高级vlookup，带有串联功能。将其移动到一张纸中会破坏它。
SaveAsCSV子级也在工作簿级别。将其移到“说明”表上不会停止行为。
使用Excel for Mac，版本16.21.1

任何帮助将不胜感激！

编辑：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

Answer 1

尝试此操作（不复制/粘贴）：

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

VBA将工作表保存为CSV破坏现有模块

1 个答案: