Save parts of several worksheets as separate CSV files

Question

Related: Save each sheet in a workbook to separate CSV files

I’ve inherited some code that I’m trying to update. The intention is to take a particular range from each of certain (macro-generated) sheets and save them as distinct CSV files. Here’s the existing code, somewhat simplified & with error checking removed:

' 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

The line .Range("J3:J322").Select is a noop in this context, but how can I achieve what this was trying to do: save only the range J3:J322 to this new CSV file?

I'm not sure if you can save just a range, but why dont you generate your own csv? I mean it is just a text file with this format: "column1","column2" — bto.rdz, Dec 16 '13 at 20:21
The generation of the sheets is part of a complicated spreadsheet with macros I do not understand. Fortunately, the original version of this dumped the info to DBF, requiring a distinct code path; it’s this path I’m trying to hook into. — J. C. Salomon, Dec 16 '13 at 20:25

sancho.s ReinstateMonicaCellio · Answer 1 · 2013-12-16T22:33:05.013

You may copy the target range, paste it in a new worksheet (you may need to paste as values, and paste number format as well), and then save that worksheet.

The code below embodies the idea. Lines commented with '* are added/modified as compared to your code. A few things to bear in mind:

By pasting values, you prevent the (unlikely) case of having cells with functions whose evaluated value changes upon pasting in the newly created workbook.
Using rng instead of selecting the Range is the recommended practice. If you do not have a lot of these operations, you would likely not notice the (minor) time saving.

Disabling DisplayAlerts eliminates alerts during macro execution (please see this to find out if you would like to make adjustments).

' 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

Could you please expand this a bit? I’ve tried to do this, and keep getting my code confused regarding which file is open. (I’m not terribly familiar with VBA or programming Excel, as may be apparent.) — J. C. Salomon, Dec 16 '13 at 20:29
Would `.Range("J3:J322").Copy` work as well as the two lines above? — J. C. Salomon, Dec 16 '13 at 23:11

score 1 · Accepted Answer · answered Dec 16 '13 at 20:47

I've augmented your code and added comments. This code creates a temporary workbook to copy/paste your selection and save it. The temporary workbook is then closed. Note that this code will overwrite existing files without prompts. If you wish to see prompts, then remove the Application.DisplayAlerts lines before and after the loop.

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

Save parts of several worksheets as separate CSV files

2 Answers2