合并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运行代码,选择要合并的文件,效果如下
联系客服