具体操作如下：
1、首先把要合并的多个excel表都放在同一个文件夹里面，并在这个文件夹里面新建一个excel。
2、用microsoft excel打开新建的excel表，并右键单击sheet1，找到“查看代码”，单击进去。进去之后就看到了宏计算界面。
3、然后我们把下面这些宏计算的代码复制进去，然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”，代码如下，可直接复制粘贴
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
那么上面的代码得到的合并在一起的Excel表格表头是重复的，那该怎么去表头呢？
具体的操作方法和上面一样，具体的代码看下面，直接复制就好啦。看下面的代码，下面的代码是只保留一个表头的：
Sub MergeMultiFiles()Dim filePath As String, fileName As String, mergedWorkbookName As String, processedFileNames As StringDim Workbook As WorkbookDim copyRange As RangeDim i As LongPtrDim num As LongPtrDim box As StringDim headerCount As IntegerheaderCount = 1 ' 表头行数，根据实际情况设置Application.ScreenUpdating = FalsefilePath = ThisWorkbook.PathfileName = Dir(filePath & "\" & "*.xls")mergedWorkbookName = ThisWorkbook.Namenum = 0Do While fileName <> ""If fileName <> mergedWorkbookName ThenSet Workbook = Workbooks.Open(filePath & "\" & fileName)num = num + 1With ThisWorkbook.ActiveSheet' .Cells(.Range("A65535").End(xlUp).Row + 2, 1).Value = Left(fileName, Len(fileName) - 5)For i = 1 To Workbook.Sheets.CountIf num = 1 And i = 1 ThenWorkbook.Sheets(i).UsedRange.Copy .Cells(1, 1)ElseSet copyRange = Workbook.Sheets(i).UsedRangecopyRange.Offset(headerCount, 0).Resize(copyRange.Rows.Count - headerCount, copyRange.Columns.Count).Copy .Cells(.Range("A65535").End(xlUp).Row + 1, 1)End IfNextEnd WithprocessedFileNames = processedFileNames & Chr(13) & Workbook.NameWorkbook.Close FalseEnd IffileName = Dir()LoopUsedRange.Columns.AutoFitRange("A1").SelectApplication.ScreenUpdating = TrueMsgBox "共合并了" & num & "个工作薄下的全部工作表。文件名如下：" & processedFileNames, vbInformation, "提示"
End Sub
参考文章：
https://www.codeleading.com/article/71383848503/
https://blog.csdn.net/baidu_31950961/article/details/98640001
https://blog.csdn.net/corpse2010/article/details/89850175
本文链接：https://my.lmcjl.com/post/11143.html
展开阅读全文
4 评论