I am familar with excel but still quite new to VBAs. I have a report with multiple sheets that i want to export a specific range and save the files into seperate CSV files.

I have been able to export the and save the files with the below code. Now i want to add the code to export the sheets with the range("E6:V100").

How can i add this in with my below code.

Any help is appreciated.

Option Explicit

Sub WriteCSVs()

    Dim mySheet As Worksheet
    Dim myPath As String

    myPath = SelectFolder
    
    Application.DisplayAlerts = False
    For Each mySheet In ActiveWorkbook.Worksheets
        If mySheet.Visible = xlSheetVisible Then
            'MsgBox CStr(mySheet.Visible)
            ActiveWorkbook.Sheets(mySheet.Index).Copy
            'ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
            ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Range("B2"), FileFormat:=xlCSV
            ActiveWorkbook.Close
        End If
    Next mySheet
    Application.DisplayAlerts = True

End Sub

Function SelectFolder() As String

    Dim FldrPicker As FileDialog
    Dim myFolder As String

    'Have User Select Folder to Save to with Dialog Box
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Function
        SelectFolder = .SelectedItems(1) & "\"
    End With
  

End Function

CodePudding user response：

Put this within your Application.DisplayAlerts lines, either replacing the existing code (if you only want to save the specific Range), or after/before the existing code (if you want to save both the specific Range and your entire Worksheet, as now):

Dim newWkb As Workbook, fullPath As String
For Each mySheet In ActiveWorkbook.Worksheets
    If mySheet.Visible = xlSheetVisible Then
        mySheet.Range("E6:V100").Copy
        Set newWkb = Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
        newWkb.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
        fullPath = myPath   mySheet.Name   ".csv"
        Kill fullPath
        newWkb.SaveAs fullPath, XlFileFormat.xlCSV
        newWkb.Close False
    End If
Next mySheet

This code:

• Assumes myPath is a valid folder
• Uses the name of each Worksheet for the filename so it assumes that name is legal as a filename (you can swap to using cell "B2", as you do in your own code, if you want ... but obviously you can't use the same name for the specific Range and for the entire Worksheet if you are wanting to save both)
• If a file with the same name already exists in the myPath folder, then it will be overwritten

CodePudding user response：

Export Ranges to CSV-s

Sub ExportRangesToCSVs()

    Const SOURCE_RANGE_ADDRESS As String = "E6:V100"
    Const DESTINATION_FILE_NAME_CELL_ADDRESS As String = "B2"
    
    Dim myPath As String: myPath = SelectFolder
    If Len(myPath) = 0 Then Exit Sub
    
    Dim swb As Workbook: Set swb = ActiveWorkbook
    
    Dim dwb As Workbook: Set dwb = Workbooks.Add(xlWBATWorksheet)
    Dim dws As Worksheet: Set dws = dwb.Worksheets(1)
    Dim drg As Range
    With dws.Range(SOURCE_RANGE_ADDRESS)
        Set drg = dws.Range("A1").Resize(.Rows.Count, .Columns.Count)
    End With
    
    Application.ScreenUpdating = False
    
    Dim sws As Worksheet
    Dim srg As Range
    
    For Each sws In swb.Worksheets
        Set srg = sws.Range(SOURCE_RANGE_ADDRESS)
        drg.Value = srg.Value
        Application.DisplayAlerts = False
            dws.SaveAs myPath _
                & sws.Range(DESTINATION_FILE_NAME_CELL_ADDRESS).Value, xlCSV
        Application.DisplayAlerts = True
    Next sws
    
    dwb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
End Sub