快速合并同一个excel表中的多个sheet

来源：互联网发布：sketch mac 汉化补丁编辑：程序博客网时间：2024/05/19 12:40

很多朋友会遇到这样的问题，就是很有很多页的数据，少的有几十页，多的可能有几百页，然后需要合并到一个页面做数据分析，如果一页页的复制粘贴的话，就比较麻烦。下面我就介绍一种利用excel的宏计算来解决这个问题。

一、数据准备

二、合并效果

三、代码

在Sheet1上右键→查看代码，打开代码编辑器，写入如下内容：

Sub UnionSheets()    Application.ScreenUpdating = False    For i = 1 To Sheets.Count       If Sheets(i).Name <> ActiveSheet.Name Then           X = Range("A65536").End(xlUp).Row + 1   '获取当前sheet中已有的行数，从+1行开始           Sheets(i).UsedRange.Copy Cells(X, 1)    '往当前sheet中的Cells(X, 1)开始复制数据       End If    Next    Range("A1").Select '选中第一个单元格（返回到顶部）    Application.ScreenUpdating = True    MsgBox "合并完毕！", vbInformation, "提示"End Sub

另外，将多个Excel文件合并为一个，可用如下代码来实现：

Sub combo()Dim Wk As Workbook, Sht As Worksheet, n As Integer, MyPath, MyNameApplication.ScreenUpdating = FalseApplication.EnableEvents = Falsen = 1MyPath = ThisWorkbook.Path & "\"  '指定路径MyName = Dir(MyPath & "\" & "*.xls") '寻找第一项Do While MyName <> ""   '开始循环If MyName <> ThisWorkbook.Name ThenSet Wk = Workbooks.Open(MyPath & "\" & MyName)Wk.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) '此处只插个第一个sheetThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Mid(MyName, 1, Len(MyName) - 4) '重新命名sheet'For Each Sht In Wk.Sheets '多个sheet'Sht.Name = Format(n, "000″)'n = n + 1'NextWk.Close FalseEnd IfMyName = Dir    '查找下一个LoopApplication.ScreenUpdating = TrueApplication.EnableEvents = TrueEnd Sub

0 0