工作薄拆分为多个文件

sunny_8848

没找到论坛合适的实例，请大家帮忙。将一个工作薄内的多个工作表拆分为单个文件，格式保持不变，文件名称就是工作表名称，如果已经存在就覆盖原来的。
新建文件夹.rar (29.76 KB, 下载次数: 11)

2024-11-7 13:51 上传

点击文件名下载附件

lcluck2002

推荐本坛的易用宝Plus，这类问题秒杀。

z865593849

拆分工作表

ykcbf1100

总表按表名拆分为多工作簿，自动跳过空表。

ykcbf1100

参与一下。。。

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    p = wb.Path & "\"
    For Each sht In Sheets
        If sht.UsedRange.Cells.Count > 1 Then
            sht.Copy
            ActiveWorkbook.SaveAs p & sht.Name
            ActiveWorkbook.Close
        End If
    Next
    Beep
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

沧海一粟123123

Sub test()
Dim sh As Worksheet
Dim i As Integer

Application.DisplayAlerts = False
For i = 1 To Sheets.Count
    If Not Sheets(i).Name Like "*Sheet*" Then
        Sheets(i).Copy
        Set sh = ActiveSheet
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name & ".xlsx"
    ActiveWorkbook.Close True
    End If
Next i
Application.DisplayAlerts = True
End Sub

sunny_8848

lcluck2002 发表于 2024-11-7 14:00
推荐本坛的易用宝Plus，这类问题秒杀。

谢谢关注，想集成到自己的表格中

sunny_8848

quqiyuan 发表于 2024-11-7 14:44
代码如下。。。
Sub test()
    Application.ScreenUpdating = False

谢谢您的帮忙，效果不错