1,、代碼

Sub company()

Application.ScreenUpdating = False

Dim mypatth As String

Dim sh As Worksheet

mypath = ThisWorkbook.Path & '\數(shù)據(jù)統(tǒng)計匯總'

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

    MsgBox '不純在分發(fā)單位文件夾，請手動添加'

    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