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

相关： 将工作簿中的每张工作表保存为独立的CSV文件

我已经inheritance了一些我试图更新的代码。 目的是从每个特定的（macros生成的）工作表取一个特定的范围，并将其保存为不同的CSV文件。 这里是现有的代码，有些简化，删除了错误检查：

' 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

我已经增加了您的代码并添加了评论。 此代码创build一个临时工作簿来复制/粘贴您的select并保存它。 临时工作簿然后closures。 请注意，这段代码会覆盖现有文件而不提示。 如果您希望看到提示，请在循环前后移除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 

Answer 2

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

下面的代码体现了这个想法。 与您的代码相比，用'*表示的行被添加/修改。 有几件事要记住：

1. 通过粘贴值，可以防止（不太可能）使单元格的function在评估值粘贴到新创build的工作簿时发生变化。

2. 推荐使用rng而不是selectRange。 如果你没有很多这些操作，你可能不会注意到（小）节省时间。

3. 禁用DisplayAlerts消除macros执行期间的警报（请参阅DisplayAlerts以了解是否要进行调整）。

    ' 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