将工作表导出到新的工作簿的宏，除了特定的工作表。

Question

所以我有一个宏，可以将每个工作表导出到一个新的工作簿中。现在我的问题是，我不想导出一个特定的表名（s）（"源 "表让我们说），当我添加代码 "如果xWs.name<> "源"，然后添加其他和结束，如果我仍然得到 "如果没有块如果等 "错误。我试了很多方法，但都没有用。

谁能帮帮我？

    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 xWs.name<>..."。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