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