VBA合并拆分工作簿（表）源代码

'合并工作簿函数01

Function hebing(path As String)

Dim i As Integer

Dim wb As Workbook

Dim sh As Worksheet

Dim name As String

If VBA.Strings.Right(path, 1) <> "\" Then

path = path & "\"

End If

name = Dir(path & "*.xls*")

For i = 1 To 1000

Set wb = Workbooks.Open(path & name)

For Each sh In wb.Sheets

sh.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).name = Split(wb.name, ".")(0) & sh.name

Next

wb.Close

name = Dir

If name = "" Then

Exit For

End If

Next

ThisWorkbook.Sheets(1).Select

End Function

'合并工作簿函数02

Function hebing2()

Dim i, j As Integer

Dim paths()

paths = Application.GetOpenFilename("excel,*.xls*", , , , True)

If paths(1) = "False" Then

GoTo 100

End If

j