excel拆分与合并方法(VBA编程)

一、将excel工作簿中的多个工作表合并与拆分

1、工作簿内合并

假设各个表的A列为必填字段。按住alt依次单击F11、I、M，复制并运行下面的代码。

Sub 数据集中()

Sheets(1).Select

For i = 2 To ThisWorkbook.Sheets.Count

Sheets(i).UsedRange.Copy

Sheets(1).[A65536].End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Next i

Application.CutCopyMode = False

End Sub

2、拆分

将一个工作簿中的多个工作表折分成多个工作簿

Sub 另存所有工作表为工作簿()

Dim sht As Worksheet

Application.ScreenUpdating = False

ipath = ThisWorkbook.Path & "\"

For Each sht In Sheets

sht.Copy

ActiveWorkbook.SaveAs ipath & & ".xls" '(工作表名称为文件名）

ActiveWorkbook.Close

Next

Application.ScreenUpdating = True

End Sub

二、将多个工作簿合并到一个工作簿

具体步骤：

1、上网找来下面的代码。

Private Sub CommandButton1_Click()

Dim Sh As Worksheet, MyName$, n%

Application.DisplayAlerts = False

Application.ScreenUpdating = False

If ThisWorkbook.Sheets.Count > 1 Then

If MsgBox("重新导入报表将删除原来报表，继续吗？", 52, "警告") = 7 Then Exit Sub End If

On Error Resume Next

For Each Sh In Worksheets

If <> Then

Sh.Delete

End If

Next

n = 1

MyName = Dir(ThisWorkbook.Path & "\*.xls")

Range("a2:b65536").ClearContents

Range("a2:b65536").Hyperlinks.Delete

Do While MyName <> ""

If MyName <> Then

Workbooks.Open ThisWorkbook.Path & "\" & MyName

ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(n)

n = n + 1

ThisWorkbook.Sheets(n).Name = Left(MyName, InStr(MyName, ".") - 1)

Range("a" & n) = n - 1

Me.Hyperlinks.Add Range("b" & n), Address:="", SubAddress:="'" & ThisWorkbook.Sheets(n).Name & "'!A1", ScreenTip:=ThisWorkbook.Sheets(n).Name, TextToDisplay:=ThisWorkbook.Sheets(n).Name ActiveSheet.Hyperlinks.Add ActiveSheet.Range("g1"), Address:="", SubAddress:=Sheets(1).Name & "!A1", ScreenTip:="返回首页", TextToDisplay:="返回"

Workbooks(MyName).Close

End If

MyName = Dir

Loop

Me.Activate

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

2、新建Excel文档，创建一个按钮，将找来的代码放到按钮上。

3、将文档保存，和那n个文件存放到同一个文件夹。

4、点击刚才创建的按钮，即可将n张表格合并到当前这个文档里（工作簿）。