Question

我有一个excel文件，其中包含20多个工作表，我了解如何将它们拆分为单个文件，并将其工作表名称作为新工作簿名称（.xlsx）。下面是我的vba代码。

Sub Splitbook()

MyPath = ThisWorkbook.Path

For Each sht In ThisWorkbook.Sheets
    sht.Copy
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecialPaste:=xlPasteValues
    ActiveSheet.Cells.PasteSpecialPaste:=xlPasteFormats
    ActiveSheet.Cells.Hyperlinks.Delete
    ActiveWorkbook.SaveAs Filename:=MyPath & "\" & sht.Name & ".xlsx"
    ActiveWorkbook.Closesavechanges:=False
Next sht

End Sub

但是现在，我想做一些改变。

更多细节，我的工作表名称为＆＃34;注意＆＃34;，＆＃34; JAN 16＆＃34;，＆＃34; FEB 16＆＃34; ....等

我会将它们拆分为单独的文件，但包括工作表＆＃34;注意＆＃34;。

表示工作表＆＃34;注意＆＃34; +工作表＆＃34; 1月16日＆＃34; - ＆GT;新工作簿名称为＆＃34; JAN 16＆＃34; ; 工作表＆＃34;注意＆＃34; +工作表＆＃34; FEB 16＆＃34; - ＆GT;新工作簿名称为＆＃34; FEB 16＆＃34; ...等

我尝试了很多次但没有成功。

请帮忙...... 提前谢谢。

Answer 1

看看这是否适合您。它复制月份表（JAN 16等）之后的“注释”表，但您可以通过取出逗号（例如wNote.Copy ActiveWorkbook.Sheets(1)）将其放在前面。

Sub SplitWorkbook()

Dim MyPath As String
Dim sht As Worksheet, wNote As Worksheet

On Error GoTo ErrorHandler

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wNote = ThisWorkbook.Sheets("NOTE")

MyPath = ThisWorkbook.Path

For Each sht In ThisWorkbook.Sheets

    If sht.Name <> "NOTE" Then

        'copy the sheet in question (not giving a parameter copies it to a new wb)
        sht.Copy

        'apply formatting to sheet as desired (paste values, remove hyperlinks, etc.)
        ActiveSheet.Cells.Copy
        ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Cells.Hyperlinks.Delete

        'copy note sheet after first sheet
        wNote.Copy , ActiveWorkbook.Sheets(1)

        'make sure new workbook shows the first sheet
        Application.Goto ActiveWorkbook.Sheets(1).Cells(1, 1)

        'save and close
        ActiveWorkbook.SaveAs Filename:=MyPath & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False

    End If

Next sht

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Exit Sub

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Error # " & Err.Number & " - " & Err.Description, vbCritical, "Error"

Exit Sub

End Sub

将excel工作簿拆分为单独的工作簿

1 个答案: