合并多个Excel

合并excel分为两种情况：1、将多个excel文件合并在一个excel中的不同sheet中。2、将多个excel文件合并在一个excel文件的一个sheet中。

1、将多个excel的文件合并在一个excel文件的不同sheet中。

（1）首先，我们在Epan下的vb文件夹中创建4个excel文件，明明如下。

（2）打开命名为allExcel文件，按alt+F11调出vb编辑接口

（3）点击ThisWorkBook,并粘贴如下代码：

Private Sub hb()





    Dim hb As Object, kOne As Boolean, tabcolor As Long





    Set hb = Workbooks.Add





    Application.DisplayAlerts = False





    For i = hb.Sheets.Count To 2 Step -1





        hb.Sheets(i).Delete





    Next





     





    Dim FileName As String, FilePath As String





    Dim iFolder As Object, rwk As Object, Sh As Object





    Set iFolder = CreateObject("shell.application").BrowseForFolder(0, "请选择要合并的文件夹", 0, "")





    If iFolder Is Nothing Then Exit Sub





    FilePath = iFolder.Items.Item.Path





    FilePath = IIf(Right(FilePath, 1) = "\", FilePath, FilePath & "\")





    FileName = Dir(FilePath & "*.xls*")





    Do Until Len(FileName) = 0





        If UCase(FilePath & FileName) <> UCase(ThisWorkbook.Path & "\" & ThisWorkbook.Name) Then





            Set rwk = Workbooks.Open(FileName:=FilePath & FileName)





            tabcolor = Int(Rnd * 56) + 1





            With rwk





                For Each Sh In .Worksheets





                    Sh.Copy After:=hb.Sheets(hb.Sheets.Count)





                    hb.Sheets(hb.Sheets.Count).Name = FileName & "-" & Sh.Name





                    hb.Sheets(hb.Sheets.Count).Tab.ColorIndex = tabcolor





                    If Not kOne Then hb.Sheets(1).Delete: kOne = True





                Next





                .Close True





             End With





        End If





        Set rwk = Nothing





        FileName = Dir





    Loop





    Application.DisplayAlerts = True





End Sub

（3）按F5运行，会弹出让你选择要合并的文件夹的窗口

（4）代码执行结果如下：

2、将多个excel文件合并在一个excel文件的一个sheet中。

（1）打开allExcel调出VB编程接口，粘贴如下代码

sub 合并当前目录下所有工作簿的全部工作表() 





dim mypath, myname, awbname 





dim wb as workbook, wbn as string 





dim g as long 





dim num as long 





dim box as string 





application.screenupdating = false 





mypath = activeworkbook.path 





myname = dir(mypath & "\" & "*.xls") 





awbname = activeworkbook.name 





num = 0 





do while myname <> "" 





if myname <> awbname then 





set wb = workbooks.open(mypath & "\" & myname) 





num = num + 1 





with workbooks(1).activesheet 





.cells(.range("a65536").end(xlup).row + 2, 1) = left(myname, len(myname) - 4) 





for g = 1 to sheets.count 





wb.sheets(g).usedrange.copy .cells(.range("a65536").end(xlup).row + 1, 1) 





next 





wbn = wbn & chr(13) & wb.name 





wb.close false 





end with 





end if 





myname = dir 





loop 





range("a1").select 





application.screenupdating = true 





msgbox "共合并了" & num & "个工作薄下的全部工作表。如下：" & chr(13) & wbn, vbinformation, "提示" 





end sub

（2）按F5运行代码，选择要合并的文件，效果如下