将设定范围的工作表导出为CSV

nx7onnlm 于 2022-12-06 发布在其他

关注(0)|答案(2)|浏览(76)

我熟悉excel，但对VBAs还很陌生。我有一个有多个工作表的报表，我想导出一个特定的范围，并将文件保存到单独的CSV文件中。
我已经能够用下面的代码导出并保存文件。现在我想添加代码来导出范围为（“E6：V100”）的工作表。
我怎么能添加这个与我下面的代码。
任何帮助都是感激不尽的。

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

csv

来源：https://stackoverflow.com/questions/74312505/exporting-worksheet-with-set-range-to-csv

2条答案

按热度按时间

dzhpxtsq1#

将此代码放在Application.DisplayAlerts行中，替换现有代码（如果您只想保存特定的Range），或者在现有代码之后/之前（如果您想保存特定的Range和整个工作表，就像现在一样）：

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

此代码：

假设myPath是有效的文件夹
使用每个工作表的名称作为文件名，因此它假定该名称作为文件名是法律的的（如果需要，您可以切换到使用单元格“B2”，就像您在自己的代码中所做的那样......但如果您要保存特定范围和整个工作表，显然不能使用相同的名称）
如果myPath文件夹中已存在同名文件，则该文件将被覆盖

赞(0）回复(0）举报 2022-12-06

laximzn52#

将范围导出到CSV

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

赞(0）回复(0）举报 2022-12-06

我来回答

将设定范围的工作表导出为CSV

2条答案

将范围导出到CSV

相关问题

热门标签

最新问答