VBA脚本将工作簿中的所有工作表拆分为单独的文件 [英] VBA Script to split all worksheets in a workbook to separate files

问题描述

我有一个脚本，可以对工作簿中的每个工作表进行vlookup，然后将每个工作表拆分为自己的文件.我有以下脚本，但无法正常工作.vlookup部分工作正常，但拆分时出现问题.它不会失败并给我一个错误，它什么也不会做.

I have a script that does a vlookup for each sheet in workbook and then splits each worksheet into its own file. I have the below script, but it is not working. The vlookup portion is working fine, but I am having issues with the split. It doesn't fail and give me an error, it just doesn't do anything.

Sub Splitbook()
MyPath = "***Folder Location***"
For Each sht In Workbooks("PO135 Division 1.xlsx").Worksheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub

我需要分割文件，然后将它们保存在一个单独的文件夹中(" 文件夹位置 ").将在运行脚本之前进行更新

I need to split the files and then save them in a distinct folder("Folder Location")--this is just a placeholder for the time being, it would be updated prior to running the script--

有什么想法吗?感谢帮助！

Any thoughts? Appreciate the help!

推荐答案

将其放在常规模块中

Sub NewWb()
Dim ws As Worksheet
Dim wbActive As Workbook
Dim wbNew As Workbook
Dim x As Single
Application.ScreenUpdating = False
    Set wbActive = ActiveWorkbook

    For Each ws In wbActive.Worksheets
        Set wbNew = Workbooks.Add
        ws.Copy Before:=wbNew.Sheets(1)
        abc = "C:\Files\" & ws.Name & ".xlsx"
        Application.DisplayAlerts = False
        wbNew.Sheets("Sheet1").Delete
        Application.DisplayAlerts = True
        wbNew.SaveAs Filename:=abc
        wbNew.Close Saved = True
    Next ws
    Set ws = Nothing
    Set wbActive = Nothing
    Set wbNew = Nothing
    Application.ScreenUpdating = True    
End Sub

这篇关于VBA脚本将工作簿中的所有工作表拆分为单独的文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！