多个excel合并为一个 多个文件合并为一个

并没有学过VBA，工作需要把多个excel合并为一个，成功之后略微研究了一下原理，希望可以用在其他场合

参考文献

https://www.zhihu.com/question/20366713

https://jingyan.baidu.com/article/148a19218539ae4d70c3b161.html

先上流程：

目的就是把一个文件夹里的多个文件合并到一起

然后 首先要新建一个excel，作为汇总目标：

1. • 

   • 用excel打开

     

   • 右击Sheet1

     

   • 选择查看代码

     

     将下列代码复制到文本框中：

   • 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("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
     
     For G = 1 To Sheets.Count
     
     Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
     
     Next
     
     WbN = WbN & Chr(13) & Wb.Name
     
     Wb.Close False
     
     End With
     
     End If
     
     MyName = Dir
     
     Loop
     
     Range("B1").Select
     
     Application.ScreenUpdating = True
     
     MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
     
     End Sub

     

   • 点击运行

     

   • 一段时间（取决于表格的大小和多少）后，合并完成了

     

其他的合并需求

有时候不需要把文件合并到一个sheet表中，而是需要把所有文件复制到一个excel不同的表单（sheet）里；代码如下

代码如下：

Sub 汇总数据()
Application.ScreenUpdating = False
Dim wb, wb1 As Excel.Workbook
Dim sh As Excel.Worksheet
s = Split(ThisWorkbook.Name, ".")(1)

f = Dir(ThisWorkbook.Path & "\*" & s) '生成查找EXCEL的目录
Do While f <> "" '在目录中循环
If f <> ThisWorkbook.Name Then '如果不是打开的工作簿

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)

wb.Worksheets("sheet1").Copy after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = Split(wb.Name, ".")(0)
wb.Close
End If

f = Dir
Loop
ThisWorkbook.Worksheets("汇总").Activate
Application.ScreenUpdating = True
End Sub

还有的时候需要将同一个excel中的所有sheet汇总在一个sheet中

代码如下：

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, "提示"

这个啥原理呢？我也不知道

方法都有了 原理以后研究一下更新吧