VBA宏将文档拆分并保存到单独的文件中

Question

我正在研究excel中的宏，我差不多完成了，最后一件事一直困扰着我，我想在使用它之前添加它，作为一种安全/控制机制。

代码应该将数据放在一张纸上，分析哪些行属于特定动态定义的变量（其中一行），并因此创建单独的受密码保护的xlsx文件。

困扰我的是我无法让ELSE语句将信息附加到结果输出中，而是覆盖它。

代码如下：

Option Explicit

'Split data into separate PWD protected XLSX files based on a set variable in second sheet.

Sub SplitData()
    Dim WB As Workbook
    Dim p As Range

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False

    For Each p In Sheets("Support").Range("Variable")

        If p.Value = 1 Then

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 123
        WB.Close

        ElseIf p.Value = 2 Then

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 234
        WB.Close

        ElseIf p.Value = 3 Then

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 345
        WB.Close

        ElseIf p.Value = 4 Then

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 456
        WB.Close

        ElseIf p.Value = 5 Then

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF" & p.Value, xlWorkbookDefault, 567
        WB.Close

        Else

        Workbooks.Add
        Set WB = ActiveWorkbook
        ThisWorkbook.Activate

        WriteToWorkbook WB, p.Value

        WB.SaveAs ThisWorkbook.Path & "\Test_" & "WTF", xlWorkbookDefault, 147
        WB.Close
        End If

    Next p

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True

    Set WB = Nothing

End Sub

'Writes all the data in rows belonging to specific Variable to the first sheet in the named WB.

Sub WriteToWorkbook(ByVal WB As Workbook, _
                    ByVal Variable As String)
    Dim rw As Range
    Dim VariableRows As Range     'Stores all of the rows found containing the searched Variable

    For Each rw In UsedRange.Rows
        If Variable = rw.Cells(1, 4) Then    'Defines which column is to be controlled (rows, cells)
            If VariableRows Is Nothing Then
                Set VariableRows = rw
            Else
                Set VariableRows = Union(VariableRows, rw)
            End If
        End If
    Next rw

    VariableRows.Copy WB.Sheets(1).Cells(Rows.Count, 4).End(xlUp).Offset(1, 0)
    Set VariableRows = Nothing
End Sub

感谢任何和所有帮助。

非常感谢和归功于https://superuser.com/users/10554/daveparillo我根据自己的需求调整了初始脚本 - https://superuser.com/questions/57157/can-i-split-a-spreadsheet-into-multiple-files-based-on-a-column-in-excel-2007

此外，如果有人有任何想法来提高脚本的效率（它将超过10k +行并将它们分成50多个新表）。

提前谢谢。