Save a specific set of worksheets as CSV

[DE_Tx]

I have seen excellent examples of how to save all sheets in a workbook as separate csv files. But, I only want to save a "range" of sheets as csv files.

Here is my code

Sub Save_Each_Worksheet_as_CSV()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    'path to save location
    ws.SaveAs "S:\MyLocation\" & ws.Name & ".csv", xlCSV
Next
End Sub

In my project, I want to save Sheet35 through Sheet65 as separate csv files.
How do I change the above code to only save those sheets?

I am sure it involves a For...Next statement but I have no experience with those, yet.

Thanks for any assisance.

TcO

 

[Kenneth Hobson]

Change the loop from 3 to 4 to 35 to 65 IF those are the Index numbers for the sheets.

Sub Main()
  Dim ws As Worksheet, i As Integer, p$
  p = ThisWorkbook.Path & "\"
  For i = 3 To 4
    Set ws = Worksheets(i)
    RangeToCSVfile ws.UsedRange, p & ws.Name & ".csv"
  Next i
End Sub

Sub RangeToCSVfile(Optional aRange As Range, Optional csvFile As Variant = "", _
  Optional Overwrite As Boolean = True)
  Dim calc As Integer, tf As Boolean, ws As Worksheet
  'Tools > Settings > Microsoft Scripting Runtime
  'Dim f As Folder, fso As New FileSystemObject
  Dim f As Object, fso As Object
 
  With Application
    .EnableEvents = False
    calc = .Calculation
    .Calculation = xlCalculationManual
  End With

  'Set aRange if needed.
  If Selection.Count > 1 And aRange Is Nothing Then Set aRange = Selection
  On Error GoTo TheEnd
  If aRange Is Nothing Then _
    Set aRange = Application.InputBox("Range", "Selected: ", _
      "=" & Selection.Address(external:=True), Type:=8)
  On Error GoTo 0
 
  'Check if folder in passed csvFile exists.
  Set fso = CreateObject("Scripting.FileSystemObject")
  If csvFile <> "" Then
    tf = fso.FolderExists(fso.GetParentFolderName(csvFile))
  End If
  If tf = False Or csvFile = "" Then
    csvFile = ThisWorkbook.Path
    csvFile = Application.GetSaveAsFilename(csvFile, "Comma Separated Text (*.CSV), *.CSV")
  End If
 
  If csvFile <> "" And csvFile <> False Then
    'Add new workbook, copy/paste aRange, name sheet 1.
    Set ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    aRange.Copy ws.[A1]
    'ws.Name = fso.GetBaseName(csvFile)
    If Overwrite Then Application.DisplayAlerts = False
    ws.Parent.SaveAs csvFile, xlCSV, CreateBackup:=False
    Application.DisplayAlerts = True
    ws.Parent.Close False
  End If

TheEnd:
  Set fso = Nothing
  With Application
    .CutCopyMode = False
    .EnableEvents = False
    .Calculation = calc
  End With
End Sub

 

[Marc L]

Hi !

How do I change the above code to only save those sheets?

An easy mod just with VBA basics like Select Case !​

Sub Save_Each_Worksheet_as_CSV()
    Dim Ws As Worksheet
    With Application
         .DisplayAlerts = False
        .ScreenUpdating = False
For Each Ws In ActiveWorkbook.Worksheets
    Select Case Ws.Name
           Case "Sheet35" To "Sheet65"
                Ws.Copy
                ActiveWorkbook.SaveAs "S:\MyLocation\" & Ws.Name & ".csv", xlCSV
                ActiveWorkbook.Close
    End Select
Next
         .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​