收集一些vba的脚本

Posted on

分离工作簿

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub SaveWorkSheetToBook()
    Dim mbook As Workbook
    Set mbook = ActiveWorkbook
    Dim path As String
    path = mbook.FullName
    MsgBox path
    
    Dim pos%
    pos = InStrRev(path, "\")
    path = Left(path, pos)
    MsgBox path
    
    Dim i%
    For i = 1 To mbook.Worksheets.Count
        ' MsgBox mbook.Worksheets(i).Name
        mbook.Worksheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=path & mbook.Worksheets(i).Name & ".xlsx"
        ActiveWindow.Close
    Next i
End Sub