Excel工作簿拆分

1、代码

Sub company()

Application.ScreenUpdating = False

Dim mypatth As String

Dim sh As Worksheet

mypath = ThisWorkbook.Path & '\数据统计汇总'

  If Len(Dir(mypath, vbDirectory)) = 0 Then

    MsgBox '不纯在分发单位文件夹，请手动添加'

    Exit Sub

    End If

For Each sh In Worksheets

If sh.Visible = xlSheetVisible Then

sh.Copy

ActiveWorkbook.SaveAs mypath & '\' & sh.Name & '.xlsx'

ActiveWorkbook.Close True

End If

Next

Application.ScreenUpdating = True

End Sub