Question

有没有办法动态生成第二个Sub的ws In Worksheets(Array("DiscardedDataFile", "GephiNodeFile", "GephiEdgeFile"))？

编辑：更新了simoco代码和我的修订版

Sub SaveSheetsAsNewBooks3()
Dim SheetName As String
Dim MyFilePath As String
Dim fileName As String
Dim ws As Worksheet, wsN As Worksheet
Dim wb As Workbook

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

    For Each ws In Worksheets
        If ws.Index <> 1 Then
            SheetName = ws.Name
            ws.Copy

            MyFilePath = ThisWorkbook.Path & "\" & SheetName

            If Len(Dir(MyFilePath, vbDirectory)) = 0 Then
                MkDir MyFilePath
            End If

    With ActiveWorkbook
    '~save book in this folder
    ActiveWorkbook.SaveAs fileName:=MyFilePath & "\" & SheetName & "_" & Format(Now(), "DD-MM-YY hh.mm") & ".csv", FileFormat:=6
    ActiveWorkbook.Close SaveChanges:=True

 End With
 End If
 Next ws

Sheets("Source").Select
End Sub

Answer 1

如果我理解正确，你需要这样的东西：

Sub SaveSheetsAsNewBooks2()
    Dim SheetName As String
    Dim MyFilePath As String
    Dim fileName As String
    Dim ws As Worksheet, wsN As Worksheet
    Dim wb As Workbook

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    With ThisWorkbook
        For Each ws In .Worksheets
            If ws.Index <> 1 Then
                SheetName = ws.Name

                MyFilePath = ThisWorkbook.Path & "\" & SheetName

                If Len(Dir(MyFilePath, vbDirectory)) = 0 Then
                    MkDir MyFilePath
                End If
                'create new workbook
                ws.Copy

                With ActiveWorkbook
                    'save new workbook in this folder
                    .SaveAs fileName:=MyFilePath & "\" & SheetName & "_" & Format(Now(), "DD-MM-YY hh.mm") & ".csv", FileFormat:=6
                    .Close SaveChanges:=True
                End With
            End If
        Next ws

        .Worksheets(1).Select
    End With

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

动态创建工作表名称数组

1 个答案: