如何把全镇各个村的工作簿下的指定表独立出来

定敏

在一个名为“全镇各村名册生成阶梯表”文件夹下，有全镇各个村的工作簿，如图：

每个工作簿下面都有好几个表，如图：

现在我要把每个村工作簿下的《岁段名册总表》独立出来，单独保存为“XX村岁段名册总表”，同样在这个文件夹下，请问如何写代码，谢谢。

附件中，为了减小文件大小，我去掉了好几个村的表，只余下三个：

全镇各村名册生成阶梯表.zip (909.97 KB, 下载次数: 14)

2018-9-26 17:21 上传

点击文件名下载附件

changhong8

打开汇总表，确定启用宏的情况下点击按钮。

不知道为什么

如图

不知道为什么

                  

定敏

changhong8 发表于 2018-9-26 21:28
打开汇总表，确定启用宏的情况下点击按钮。

您这是把表合并到一个工作簿里来了，可不可以各个单独成文件在同一个文件夹？谢谢。

lsc900707

Sub test()
    p = ThisWorkbook.Path & "\原表\"
    f = Dir(p & "*.xls")
    Application.ScreenUpdating = False
    Do While f <> ""
        If f <> ThisWorkbook.Name Then
            Set sht = Workbooks.Open(p & f).Sheets("岁段名册总表")
            s = Left(Split(f, ".")(0), 3)
            sht.Copy
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & s & sht.Name
            ActiveWorkbook.Close
            Workbooks(f).Close False
        End If
        f = Dir
    Loop
    Set sht = Nothing
    Application.ScreenUpdating = True
    MsgBox "OK!"
End Sub

定敏

不知道为什么 发表于 2018-9-26 21:36

您的代码很简洁，只是我无法复制来验证，因为您发的是图片。

lsc900707

附件供测试效果：

不知道为什么

定敏 发表于 2018-9-26 21:46
您的代码很简洁，只是我无法复制来验证，因为您发的是图片。

几行代码可以自己写下，不复杂。