Question

我的目标是拆分工作簿的所有工作表，将它们保存为单独的文件，然后在每个新工作簿中添加指导工作表（指导工作表对于所有工作簿均相同）。该代码的一部分可以正常工作，为每个选项卡使用一个新的工作簿填充空的xPath目录。

然后，代码无缘无故地完全跳过“ Do While”循环部分。如果您注释掉For Each循环，那么它将起作用。我不知道为什么。

Sub SplitWorkbooktoFile()

    Dim xPath As String
    Dim wb As Workbook
    Dim file As String

    Set wb = ActiveWorkbook
    xPath = "C:\Users\AH Test\"
    file = Dir(xPath)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In wb.Sheets
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next

    Do While Not file = ""
        Workbooks.Open (xPath & file)
        Set wb = ActiveWorkbook
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "User Guidance"
        ThisWorkbook.Sheets("Guidance").Range("A1:C8").Copy
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Save
        wb.Close
        file = Dir
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Answer 1

感谢@Nathan_Sav提示我正确的答案。只需将文件= dir（xpath）放在每个循环之后。

Sub SplitWorkbooktoFile()

    Dim xPath As String
    Dim wb As Workbook
    Dim file As String

    Set wb = ActiveWorkbook
    xPath = "C:\Users\AH Test\"


    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In wb.Sheets
        xWs.Copy
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next

file = Dir(xPath)

    Do While Not file = ""
        Workbooks.Open (xPath & file)
        Set wb = ActiveWorkbook
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "User Guidance"
        ThisWorkbook.Sheets("Guidance").Range("A1:C8").Copy
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Sheets("User Guidance").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        wb.Save
        wb.Close
        file = Dir
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

跳过Do While循环，因为Dir函数无法识别文件

1 个答案: