将 sheet 导出到除特定 sheet 之外的新工作簿的宏

Question

所以我有一个宏可以将每个 sheet 导出到一个新的工作簿中。现在我的问题是我不想导出特定的 sheetname/(s)（"Source" sheet 可以说）并且当我添加代码“If xWs.name<>"Source" 然后添加 else 并在我仍然收到 "if without block if etc" 错误时结束。我尝试了很多方法但无法正常工作。

有人可以帮忙吗？

    Sub SplitWorkbook()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim FolderName As String
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    DateString = Format(Now, "YYYYMMDD")
    DateString2 = Format(Now, " - MMMM YYYY")
    FolderName = xWb.Path & "\" & "Re'porting_" & DateString
    MkDir FolderName
    For Each xWs In xWb.Worksheets
    xWs.Copy
    If Val(Application.Version) < 12 Then
    FileExtStr = ".xls": FileFormatNum = -4143
    Else
    Select Case xWb.FileFormat
        Case 51:
            FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If Application.ActiveWorkbook.HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56:
            FileExtStr = ".xls": FileFormatNum = 56
        Case Else:
            FileExtStr = ".xlsb": FileFormatNum = 50
    End Select
    End If
    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & 
    DateString2 & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
    Next
    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
    End Sub

Answer 1

我已经获取了您的代码并添加了所需的 If...Then...Else 语句。我还在代码中的关键步骤之间使用缩进和间距对其进行了格式化，这样可以更轻松地阅读和识别代码何时 doing/evaluating 是新的东西。

Sub SplitWorkbook()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String

Application.ScreenUpdating = False

Set xWb = Application.ThisWorkbook
DateString = Format(Now, "YYYYMMDD")
DateString2 = Format(Now, " - MMMM YYYY")
FolderName = xWb.Path & "\" & "Re'porting_" & DateString
MkDir FolderName

For Each xWs In xWb.Worksheets
    If Not xWs.Name = "Your Worksheet name to exclude" Then  'Change this string to suit your worksheets name
    xWs.Copy

        If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case xWb.FileFormat
                Case 51:
                    FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If Application.ActiveWorkbook.HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56:
                    FileExtStr = ".xls": FileFormatNum = 56
                Case Else:
                    FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If

    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & DateString2 & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
    Else
        'Go to next worksheet
    End If
Next xWs

MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

编译后运行对我来说很好（除了它在一个未保存的新工作簿中所以文件路径基本上不存在 - 所以我注释掉了 MkDir 和 ...Save声明）。

我也用过 If Not xWs = "..." 而不是 If xWs <> "..."。

Answer 2

感谢@Samuel Everson，我已经按照您的要求添加了这些行并且它有效。我在这里发布工作代码 + 我已将主题名称更改为可查找。

    Sub SplitWorkbook()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim FolderName As String
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    DateString = Format(Now, "YYYYMMDD")
    DateString2 = Format(Now, " - MMMM YYYY")
    FolderName = xWb.Path & "\" & "Reporting_" & DateString
    MkDir FolderName
    For Each xWs In xWb.Worksheets
    If Not xWs.Name = "Comands" And Not xWs.Name = "Source" Then
        xWs.Copy
        If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case xWb.FileFormat
                Case 51:
                    FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If Application.ActiveWorkbook.HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                            End If
                        Case 56:
                            FileExtStr = ".xls": FileFormatNum = 56
                Case Else:
                            FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
        xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & DateString2 & FileExtStr
        Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
        Application.ActiveWorkbook.Close False
        Else
        'go to next worksheet
        End If
    Next xWs
    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
    '
    Sheets("Comands").Activate
    End Sub

将 sheet 导出到除特定 sheet 之外的新工作簿的宏

Macro that exports sheets to new workbooks except a speciffic sheet

excel

vba

split

if-statement

worksheet