将多个Excel表内容合并到一个表中

有时候导出数据会生成许多单独的Excel表格,但是后期需要将这些导出的数据整理到一起进行筛选处理,单独打开每个Excel表格进行复制十分的麻烦,为了省时间找到了使用Excel表中的宏计算来实现快速合并的工作。

不过需要注意的是金山的WPS没有宏计算功能。只能用microsoft excel来实现。

具体操作如下:

一、做好前提工作,需要把多个Excel表都放在同一个文件夹里面,并在这个文件夹里面新建一个Excel用于数据的存放。如图所示:

二、在新建的Excel表中,右键单击Sheet1,找到“查看代码”,单击进到宏命令编辑组中。也可以直接alt+F11进入宏计算。

三、进去之后就看到了宏计算界面。然后我们把下面这些宏计算的代码复制进去,然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”,代码如下,如图所示:

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("a1048576").end(xlup).row + 2, 1) = left(myname, len(myname) - 4) 
for g = 1 to sheets.count 
wb.sheets(g).usedrange.copy .cells(.range("a1048576").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

四、运行之后,等待几秒钟,等运行完毕,就是合并完成之后,会有提示,点确定就可以了。查看合并后的数据,就是同一个文件夹里面多个excel表数据合并后的结果。效果如图所示:

以上内容是进行多个Excel表中合并到一个Excel表中,下面是拓展的两种:

拓展一、多个Excel表合并到一个Excel文件中的不同表中

Sub 工作薄间工作表合并()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(.xlsx),.xlsx", MultiSelect:=True, Title:="合并工作薄")
X = 1
While X <= UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub

拓展二、单个Excel中多表合并到一个表中

Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
   If Sheets(j).Name <> ActiveSheet.Name Then
       X = Range("A65536").End(xlUp).Row + 1
       Sheets(j).UsedRange.Copy Cells(X, 1)
   End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕!", vbInformation, "提示"
End Sub
0 条评论