Question

我需要帮助将excel工作簿中的特定选项卡保存为1）csv文件，以及2）以它们所源自的文件命名的文件。

到目前为止，我已经将其用于从单个工作簿中取出正确的选项卡并将其另存为.csv文件。

Sub Sheet_SaveAs()
 Dim wb As Workbook
 Sheets("SheetName").Copy      
 Set wb = ActiveWorkbook      
 With wb
   .SaveAs ThisWorkbook.Path & "\SheetName.csv"
   '.Close False
 End With
End Sub

如何重命名＆＃34; SheetName＆＃34;以便文件保存为，例如，Workbook1SheetName，Workbook2SheetName等。

我想通过许多excel文件的文件夹循环这个函数，因此新的.csv文件需要唯一的名称。

我在网上找到了这个，它展示了如何使用VBA循环http://www.ozgrid.com/VBA/loop-through.htm。理论上，只要每个.csv文件都有一个唯一的名称，它就可以使用上面的代码。如果我错了，请纠正我。

感谢您的帮助。

Answer 1

正如您所发现的，当您复制没有目标的工作表时，最终会得到一个由工作表副本填充的新工作簿。新工作簿成为VBA环境中的ActiveWorkbook property。若要将工作簿另存为CSV文件，您需要检索该新工作簿中唯一工作表的工作表.Name property。

Sub All_Sheet_SaveAs_CSV()
    Dim w As Long, wb As Workbook
    Dim fp As String, fn As String

    On Error GoTo bm_Safe_Exit
    'Application.ScreenUpdating = False   'stop screen flashing
    Application.DisplayAlerts = False    'stop confirmation alerts

    'start with a reference to ThisWorkbook
    With ThisWorkbook
        fp = .Path
        'cycle through each of the worksheets
        For w = 1 To Worksheets.Count
            With Worksheets(w)
                .Copy
                'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
                With ActiveWorkbook
                    fn = .Worksheets(1).Name
                    .SaveAs Filename:=fp & Chr(92) & fn, FileFormat:=xlCSV
                    .Close savechanges:=False   '<~~ already saved in line above
                End With
            End With
        Next w
    End With

bm_Safe_Exit:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

请注意，转动.DisplayAlerts会关闭您通常会收到的警告。虽然这对CSV文件格式很有用，但如果您尝试覆盖文件，它也不会发出警告。

文件格式参数为xlCSV的{{3}}将提供正确的文件扩展名。无需将其作为文件名的一部分包含在内。

如果有限数量的特定工作表用于接收导出到CSV过程，则可以循环访问工作表名称数组而不是工作表索引位置。

Sub Specific_Sheets_SaveAs_CSV()
    Dim v As Long, vWSs As Variant
    Dim fp As String, fn As String

    On Error GoTo bm_Safe_Exit
    'Application.ScreenUpdating = False   'stop screen flashing
    Application.DisplayAlerts = False    'stop confirmation alerts

    vWSs = Array("Sheet1", "Sheet3", "Sheet5")

    'start with a reference to ThisWorkbook
    With ThisWorkbook
        fp = .Path
        'cycle through each of the worksheets
        For v = LBound(vWSs) To UBound(vWSs)
            With Worksheets(vWSs(v))
                .Copy
                'the ActiveWorkbook is now the new workbook populated with a copy of the current worksheet
                With ActiveWorkbook
                    fn = .Worksheets(1).Name
                    .SaveAs Filename:=fp & Chr(92) & fn, FileFormat:=xlCSV
                    .Close savechanges:=False   '<~~ already saved in line above
                End With
            End With
        Next v
    End With

bm_Safe_Exit:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

解析excel工作簿并将特定选项卡保存为.csv文件

1 个答案: