将工作表导出到新工作簿（特定工作表除外）的宏

Question

所以我有一个宏，可以将每张工作表导出到一个新工作簿中。现在我的问题是我不想导出特定的工作表名/（s）（可以说是“源”工作表），当我添加代码“如果 xWs.name“源”然后添加 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 语句。我还在代码中的关键步骤之间使用缩进和间距对其进行了格式化，这使得代码在执行/评估新事物时更容易阅读和识别。

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 satatements）。

我也使用了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