Question

我有一张15张的工作簿，我想保存为新工作簿，保持“Sheet1”固定。

像这样，保存后我会有以下表格的文件：

File 1: "Sheet1", "Sheet2"
File 2: "Sheet1", "Sheet3"
File 3: "Sheet1", "Sheet4"
File 4: "Sheet1", "Sheet5"

这是我到目前为止所得到的

Sub Splitbook()
Dim xPath As String
Dim xWs As Worksheet 
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If xWs.Name <> "Sheet1" Then
    For Each xWs In ThisWorkbook.Sheets(Array("Sheet1", xWs)).Copy
       Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
       Application.ActiveWorkbook.Close False
    Next
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

有人可以帮助我吗？

谢谢！

Answer 1

您可以尝试以下方法。在所有工作表的循环内，您排除第一个工作表。然后，您创建一个新的工作簿并在那里复制两个必需的工作表。新工作簿的空白页被循环删除 - 这部分可能有一些更优雅的解决方案，但它可以工作。

Sub Splitbook()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim xWs As Worksheet
    Dim wb As Workbook
    For Each xWs In ThisWorkbook.Sheets
        If xWs.Name <> "Sheet1" Then
            Set wb = Workbooks.Add
            xWs.Copy before:=wb.Worksheets(1)
            ThisWorkbook.Sheets(1).Copy before:=wb.Worksheets(1)
            Do While wb.Worksheets.Count > 2
                wb.Worksheets(wb.Worksheets.Count).Delete
            Loop
            wb.SaveAs xWs.Name
            wb.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

复制并保存为多张纸张，保持固定的纸张VBA

1 个答案: