拆分和合并工作簿

1、拆分工作簿一

Private Sub 分拆工作表()

Dim sht As Worksheet

Dim MyBook As Workbook

Set MyBook = ActiveWorkbook

For Each sht In MyBook.Sheets

sht.Copy

ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & , FileFormat:=xlNormal '将工作簿另存为EXCEL默认格式

ActiveWorkbook.Close

Next

MsgBox "文件已经被分拆完毕!"

End Sub

2、合并工作簿

Sub CombineFiles()

Dim path As String

Dim FileName As String

Dim LastCell As Range

Dim Wkb As Workbook

Dim WS As Worksheet

Dim ThisWB As String

Dim MyDir As String

MyDir = ThisWorkbook.path & "\"

'ChDriveLeft(MyDir, 1) 'find all the excel files

'ChDir MyDir

'Match =Dir$("")

ThisWB =

Application.EnableEvents = False

Application.ScreenUpdating = False

path = MyDir

FileName = Dir(path & "\*.xlsx", vbNormal)

Do Until FileName = ""

If FileName <> ThisWB Then

Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)

For Each WS In Wkb.Worksheets

Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)

If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then

Else

WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) End If

Next WS

Wkb.Close False

End If

FileName = Dir()

Loop

Application.EnableEvents = True

Application.ScreenUpdating = True

Set Wkb = Nothing

Set LastCell = Nothing

End Sub