Question

相关： Save each sheet in a workbook to separate CSV files

我继承了一些我正在尝试更新的代码。目的是从某些（宏生成的）工作表中获取特定范围，并将它们另存为不同的CSV文件。这是现有的代码，有点简化＆amp;删除错误检查：

' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
    Dim CurrentSheet As Integer
    For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
        ActiveWorkbook.Worksheets(CurrentSheet).Activate
        With ActiveWorkbook.Worksheets(CurrentSheet)
            If (.Name <> "Table") Then
                .Range("J3:J322").Select
                .SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
            End If
        End With
    Next CurrentSheet
End Sub

在这种情况下，行.Range("J3:J322").Select是一个noop，但我怎样才能实现这一目的：只将范围J3：J322保存到这个新的CSV文件中？

Answer 1

您可以复制目标范围，将其粘贴到新工作表中（您可能需要粘贴为值，并粘贴数字格式），然后保存该工作表。

下面的代码体现了这个想法。与您的代码相比，添加/修改了使用'*注释的行。需要注意的一些事项：

通过粘贴值，可以防止（不太可能）出现具有在新创建的工作簿中粘贴时评估值发生变化的函数的单元格。
建议使用rng而不是选择范围。如果你没有很多这些操作，你可能不会注意到（次要）节省时间。

禁用DisplayAlerts会在宏执行期间消除警报（请参阅this以了解您是否要进行调整）。

' Save sheets not named "Table" as CSV files
Sub Extract_CSV()
    Dim CurrentSheet As Integer
    For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
        ActiveWorkbook.Worksheets(CurrentSheet).Activate
        Application.DisplayAlerts = False   '*
        With ActiveWorkbook.Worksheets(CurrentSheet)
            If (.Name <> "Table") Then
                '.Range("J3:J322").Select
                Dim rng As Range   '*
                Set rng = .Range("J3:J322")   '*
                rng.Copy   '*
                Dim wb As Workbook   '*
                Set wb = Application.Workbooks.Add   '*
                wb.Worksheets(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                  xlNone, SkipBlanks:=False, Transpose:=False   '*
                wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True   '*
                wb.Close   '*
            End If
        End With
        Application.DisplayAlerts = True   '*
    Next CurrentSheet
End Sub

Answer 2

我已经扩充了您的代码并添加了评论。此代码创建一个临时工作簿来复制/粘贴您的选择并保存它。然后关闭临时工作簿。请注意，此代码将在没有提示的情况下覆盖现有文件。如果您希望看到提示，请在循环之前和之后删除Application.DisplayAlerts行。

Sub Extract_CSV()
    Dim wb As Workbook
    Dim CurrentSheet As Integer
    For CurrentSheet = 1 To ActiveWorkbook.Worksheets.Count
        ActiveWorkbook.Worksheets(CurrentSheet).Activate
        'Suppress Alerts so the user isn't prompted to Save or Replace the file
        Application.DisplayAlerts = False
        With ActiveWorkbook.Worksheets(CurrentSheet)
            If (.Name <> "Table") Then
                'Select the range and copy it to the clipboard
                .Range("J3:J322").Select
                Selection.Copy
                'Create a temporary workbook and paste the selection into it
                Set wb = Application.Workbooks.Add
                wb.Worksheets(1).Paste
                'Save the temporary workbook with the name of the the sheet as a CSV
                wb.SaveAs Filename:=ActiveSheet.Name, FileFormat:=xlCSV, CreateBackup:=True
                'Close the workbook
                wb.Close
            End If
        End With
        'Restore alerts
        Application.DisplayAlerts = True
    Next CurrentSheet
End Sub

将多个工作表的一部分保存为单独的CSV文件

2 个答案: